teal.modules.clinical coverage - 28.59%

Files
Source

#' Template: Mixed Model Repeated Measurements (MMRM) Analysis
#'
#' Creates a valid expression to generate analysis tables and plots for Mixed Model Repeated Measurements.
#'
#' @inheritParams template_arguments
#' @param method (`string`)\cr a string specifying the adjustment method.
#' @param cor_struct (`string`)\cr a string specifying the correlation structure, defaults to
#'   `"unstructured"`. See [tern.mmrm::build_formula()] for more options.
#' @param weights_emmeans argument from [emmeans::emmeans()], "proportional" by default.
#' @param parallel (`flag`)\cr flag that controls whether optimizer search can use available free cores on the
#'   machine (not default).
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_a_mmrm()]
#'
#' @keywords internal
template_fit_mmrm <- function(parentname,
                              dataname,
                              aval_var,
                              arm_var,
                              ref_arm,
                              comp_arm = NULL,
                              combine_comp_arms = FALSE,
                              id_var,
                              visit_var,
                              cov_var,
                              conf_level = 0.95,
                              method = "Satterthwaite",
                              cor_struct = "unstructured",
                              weights_emmeans = "proportional",
                              parallel = FALSE) {
  # Data
  y <- list()
  data_list <- list()
  parent_list <- list()

  if (!is.null(arm_var)) {
    ref_arm_val <- paste(ref_arm, collapse = "/")

    data_list <- add_expr(
      data_list,
      prepare_arm(
        dataname = dataname,
        arm_var = arm_var,
        ref_arm = ref_arm,
        comp_arm = comp_arm,
        ref_arm_val = ref_arm_val
      )
    )


    parent_list <- add_expr(
      parent_list,
      prepare_arm(
        dataname = parentname,
        arm_var = arm_var,
        ref_arm = ref_arm,
        comp_arm = comp_arm,
        ref_arm_val = ref_arm_val
      )
    )

    if (combine_comp_arms) {
      data_list <- add_expr(
        data_list,
        substitute_names(
          expr = dplyr::mutate(arm_var = combine_levels(arm_var, levels = comp_arm)),
          names = list(arm_var = as.name(arm_var)),
          others = list(comp_arm = comp_arm)
        )
      )
      parent_list <- add_expr(
        parent_list,
        substitute_names(
          expr = dplyr::mutate(arm_var = combine_levels(arm_var, levels = comp_arm)),
          names = list(arm_var = as.name(arm_var)),
          others = list(comp_arm = comp_arm)
        )
      )
    }
  } else {
    data_list <- add_expr(
      data_list,
      substitute(
        expr = dataname,
        env = list(
          dataname = as.name(dataname)
        )
      )
    )

    parent_list <- add_expr(
      parent_list,
      substitute(
        expr = parentname,
        env = list(
          parentname = as.name(parentname)
        )
      )
    )
  }
  data_list <- add_expr(data_list, quote(df_explicit_na(na_level = default_na_str())))
  parent_list <- add_expr(parent_list, quote(df_explicit_na(na_level = default_na_str())))

  y$data <- substitute(
    expr = {
      anl <- data_pipe
      parentname <- parent_pipe
    },
    env = list(
      data_pipe = pipe_expr(data_list),
      parentname = as.name(parentname),
      parent_pipe = pipe_expr(parent_list)
    )
  )

  vars <- substitute(
    expr = list(
      response = aval_var,
      covariates = cov_var,
      id = id_var,
      arm = arm_var,
      visit = visit_var
    ),
    env = list(
      aval_var = aval_var,
      cov_var = cov_var,
      id_var = id_var,
      arm_var = arm_var,
      visit_var = visit_var
    )
  )
  y$fit <- substitute(
    expr = fit <- tern.mmrm::fit_mmrm(
      vars = vars,
      data = anl,
      conf_level = conf_level,
      method = method,
      cor_struct = cor_struct,
      weights_emmeans = weights_emmeans,
      parallel = parallel
    ),
    env = list(
      vars = vars,
      conf_level = conf_level,
      method = method,
      cor_struct = cor_struct,
      weights_emmeans = weights_emmeans,
      parallel = parallel
    )
  )

  y
}

#' @describeIn template_fit_mmrm Creates valid expressions to generate MMRM LS means, covariance matrix,
#'   fixed effects, and diagnostic tables.
#'
#' @inheritParams template_arguments
#' @param fit_name (`string`)\cr name of fitted MMRM object.
#' @param show_relative (`string`)\cr should the "reduction" (`control - treatment`, default) or the "increase"
#'   (`treatment - control`) be shown for the relative change from baseline.
#' @param table_type (`string`)\cr type of table to output.
#'
#' @keywords internal
template_mmrm_tables <- function(parentname,
                                 dataname,
                                 fit_name,
                                 arm_var,
                                 ref_arm,
                                 visit_var,
                                 paramcd,
                                 show_relative = c("increase", "reduction", "none"),
                                 table_type = "t_mmrm_cov",
                                 total_label = default_total_label(),
                                 basic_table_args = teal.widgets::basic_table_args()) {
  y <- list()
  ref_arm_val <- paste(ref_arm, collapse = "/")

  all_basic_table_args <- teal.widgets::resolve_basic_table_args(
    basic_table_args,
    module_table = teal.widgets::basic_table_args(show_colcounts = !is.null(arm_var))
  )

  # Build layout.
  layout_list <- list()
  layout_list <- layout_list %>%
    add_expr(substitute(
      expr = expr_basic_table_args,
      env = list(expr_basic_table_args = teal.widgets::parse_basic_table_args(all_basic_table_args))
    ))

  if (!is.null(arm_var)) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = rtables::split_cols_by(var = arm_var, ref_group = ref_arm),
        env = list(arm_var = arm_var, ref_arm = ref_arm_val)
      )
    )
    show_relative <- match.arg(show_relative)

    if (show_relative == "none") {
      layout_list <- add_expr(
        layout_list,
        substitute(
          expr = rtables::split_rows_by(visit_var) %>%
            append_varlabels(dataname, visit_var) %>%
            tern.mmrm::summarize_lsmeans(
              .stats = c(
                "n",
                "adj_mean_se",
                "adj_mean_ci",
                "diff_mean_se",
                "diff_mean_ci",
                "p_value"
              )
            ) %>%
            rtables::append_topleft(paste0("  ", paramcd)),
          env = list(
            dataname = as.name(dataname),
            visit_var = visit_var,
            paramcd = paramcd
          )
        )
      )
    } else {
      layout_list <- add_expr(
        layout_list,
        substitute(
          expr = rtables::split_rows_by(visit_var) %>%
            append_varlabels(dataname, visit_var) %>%
            tern.mmrm::summarize_lsmeans(show_relative = show_relative) %>%
            rtables::append_topleft(paste0("  ", paramcd)),
          env = list(
            dataname = as.name(dataname),
            visit_var = visit_var,
            paramcd = paramcd,
            show_relative = show_relative
          )
        )
      )
    }
  } else {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = rtables::add_overall_col(total_label) %>%
          rtables::split_rows_by(visit_var) %>%
          tern.mmrm::summarize_lsmeans(arms = FALSE) %>%
          rtables::append_topleft(paste0("  ", paramcd)),
        env = list(
          total_label = total_label,
          visit_var = visit_var,
          paramcd = paramcd
        )
      )
    )
  }

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  switch(table_type,
    t_mmrm_lsmeans = {
      y$lsmeans_table <- substitute(
        expr = {
          lsmeans_table <- rtables::build_table(
            lyt = lyt,
            df = df_explicit_na(broom::tidy(fit_mmrm), na_level = default_na_str()),
            alt_counts_df = parentname
          )
          lsmeans_table
        },
        env = list(
          parentname = as.name(parentname),
          fit_mmrm = as.name(fit_name)
        )
      )
    },
    t_mmrm_cov = {
      y$cov_matrix <- substitute(
        expr = {
          cov_matrix <- tern.mmrm::as.rtable(fit_mmrm, type = "cov")
          subtitles(cov_matrix) <- st
          cov_matrix
        },
        env = list(
          fit_mmrm = as.name(fit_name),
          st = basic_table_args$subtitles
        )
      )
    },
    t_mmrm_fixed = {
      y$fixed_effects <- substitute(
        expr = {
          fixed_effects <- tern.mmrm::as.rtable(fit_mmrm, type = "fixed")
          subtitles(fixed_effects) <- st
          fixed_effects
        },
        env = list(
          fit_mmrm = as.name(fit_name),
          st = basic_table_args$subtitles
        )
      )
    },
    t_mmrm_diagnostic = {
      y$diagnostic_table <- substitute(
        expr = {
          diagnostic_table <- tern.mmrm::as.rtable(fit_mmrm, type = "diagnostic")
          subtitles(diagnostic_table) <- st
          diagnostic_table
        },
        env = list(
          fit_mmrm = as.name(fit_name),
          st = basic_table_args$subtitles
        )
      )
    }
  )
  y
}

#' @describeIn template_fit_mmrm Creates valid expressions to generate MMRM LS means and
#'   diagnostic plots.
#'
#' @inheritParams template_arguments
#' @param lsmeans_plot (named `list`)\cr a `list` of controls for LS means plot.
#'   See more [tern.mmrm::g_mmrm_lsmeans()].
#' @param diagnostic_plot (named `list`)\cr a `list` of controls for diagnostic_plot.
#'   See more [tern.mmrm::g_mmrm_diagnostic()].
#'
#' @keywords internal
template_mmrm_plots <- function(fit_name,
                                lsmeans_plot = list(
                                  select = c("estimates", "contrasts"),
                                  width = 0.6,
                                  show_pval = FALSE
                                ),
                                diagnostic_plot = list(
                                  type = "fit-residual",
                                  z_threshold = NULL
                                ),
                                ggplot2_args = teal.widgets::ggplot2_args()) {
  y <- list()

  if (!is.null(lsmeans_plot)) {
    parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args(
      teal.widgets::resolve_ggplot2_args(
        user_plot = ggplot2_args[["lsmeans"]],
        user_default = ggplot2_args[["default"]]
      )
    )

    plot_call <- substitute(
      expr =
        tern.mmrm::g_mmrm_lsmeans(
          fit_mmrm,
          select = select,
          width = width,
          show_pval = show_pval,
          titles = if (is.null(fit_mmrm$vars$arm)) {
            c(
              estimates = paste("Adjusted mean of", fit_mmrm$labels$response, " at visits"),
              contrasts = " "
            )
          } else {
            c(
              estimates = paste(
                "Adjusted mean of",
                fit_mmrm$labels$response,
                "by treatment at visits"
              ),
              contrasts = paste0(
                "Differences of ",
                fit_mmrm$labels$response,
                " adjusted means vs. control ('",
                fit_mmrm$ref_level,
                "')"
              )
            )
          }
        ),
      env = list(
        fit_mmrm = as.name(fit_name),
        select = lsmeans_plot$select,
        width = lsmeans_plot$width,
        show_pval = lsmeans_plot$show_pval
      )
    )

    y$lsmeans_plot <- substitute(
      expr = {
        lsmeans_plot <- plot_call
        lsmeans_plot
      },
      env = list(
        plot_call = Reduce(function(x, y) call("+", x, y), c(plot_call, parsed_ggplot2_args))
      )
    )
  }

  if (!is.null(diagnostic_plot)) {
    parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args(
      teal.widgets::resolve_ggplot2_args(
        user_plot = ggplot2_args[["diagnostic"]],
        user_default = ggplot2_args[["default"]]
      )
    )

    plot_call <- substitute(
      expr =
        tern.mmrm::g_mmrm_diagnostic(
          fit_mmrm,
          type = type,
          z_threshold = z_threshold
        ),
      env = list(
        fit_mmrm = as.name(fit_name),
        type = diagnostic_plot$type,
        z_threshold = diagnostic_plot$z_threshold
      )
    )

    y$diagnostic_plot <- substitute(
      expr = {
        diagnostic_plot <- plot_call
        diagnostic_plot
      },
      env = list(
        plot_call = Reduce(function(x, y) call("+", x, y), c(plot_call, parsed_ggplot2_args))
      )
    )
  }

  y
}

#' teal Module: Mixed Model Repeated Measurements (MMRM) Analysis
#'
#' This module produces analysis tables and plots for Mixed Model Repeated Measurements.
#'
#' @inheritParams module_arguments
#' @inheritParams template_mmrm_tables
#' @inheritParams template_mmrm_plots
#' @param method ([teal.transform::choices_selected()])\cr object with
#'   all available choices and pre-selected option for the adjustment method.
#' @param ggplot2_args (`ggplot2_args`) optional\cr object created by [`teal.widgets::ggplot2_args()`]
#'   with settings for all the plots or named list of `ggplot2_args` objects for plot-specific settings.
#'   List names should match the following: `c("default", "lsmeans", "diagnostic")`. The argument is merged
#'   with option `teal.ggplot2_args` and with default module arguments (hard coded in the module body).
#'   For more details, see the help vignette: `vignette("custom-ggplot2-arguments", package = "teal.widgets")`.
#'
#' @note
#' The ordering of the input data sets can lead to slightly different numerical results or
#' different convergence behavior. This is a known observation with the used package
#' `lme4`. However, once convergence is achieved, the results are reliable up to
#' numerical precision.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' library(dplyr)
#' arm_ref_comp <- list(
#'   ARMCD = list(
#'     ref = "ARM B",
#'     comp = c("ARM A", "ARM C")
#'   )
#' )
#'
#' data <- teal_data()
#' data <- within(data, {
#'   ADSL <- tmc_ex_adsl
#'   ADQS <- tmc_ex_adqs %>%
#'     filter(ABLFL != "Y" & ABLFL2 != "Y") %>%
#'     filter(AVISIT %in% c("WEEK 1 DAY 8", "WEEK 2 DAY 15", "WEEK 3 DAY 22")) %>%
#'     mutate(
#'       AVISIT = as.factor(AVISIT),
#'       AVISITN = rank(AVISITN) %>%
#'         as.factor() %>%
#'         as.numeric() %>%
#'         as.factor() #' making consecutive numeric factor
#'     )
#' })
#'
#' datanames <- c("ADSL", "ADQS")
#' datanames(data) <- datanames
#' join_keys(data) <- default_cdisc_join_keys[datanames]
#' app <- init(
#'   data = data,
#'   modules = modules(
#'     tm_a_mmrm(
#'       label = "MMRM",
#'       dataname = "ADQS",
#'       aval_var = choices_selected(c("AVAL", "CHG"), "AVAL"),
#'       id_var = choices_selected(c("USUBJID", "SUBJID"), "USUBJID"),
#'       arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"),
#'       visit_var = choices_selected(c("AVISIT", "AVISITN"), "AVISIT"),
#'       arm_ref_comp = arm_ref_comp,
#'       paramcd = choices_selected(
#'         choices = value_choices(data[["ADQS"]], "PARAMCD", "PARAM"),
#'         selected = "FKSI-FWB"
#'       ),
#'       cov_var = choices_selected(c("BASE", "AGE", "SEX", "BASE:AVISIT"), NULL)
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_a_mmrm <- function(label,
                      dataname,
                      parentname = ifelse(
                        inherits(arm_var, "data_extract_spec"),
                        teal.transform::datanames_input(arm_var),
                        "ADSL"
                      ),
                      aval_var,
                      id_var,
                      arm_var,
                      visit_var,
                      cov_var,
                      arm_ref_comp = NULL,
                      paramcd,
                      method = teal.transform::choices_selected(
                        c("Satterthwaite", "Kenward-Roger", "Kenward-Roger-Linear"),
                        "Satterthwaite",
                        keep_order = TRUE
                      ),
                      conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE),
                      plot_height = c(700L, 200L, 2000L),
                      plot_width = NULL,
                      total_label = default_total_label(),
                      pre_output = NULL,
                      post_output = NULL,
                      basic_table_args = teal.widgets::basic_table_args(),
                      ggplot2_args = teal.widgets::ggplot2_args()) {
  message("Initializing tm_a_mmrm")
  cov_var <- teal.transform::add_no_selected_choices(cov_var, multiple = TRUE)
  checkmate::assert_string(label)
  checkmate::assert_string(total_label)
  checkmate::assert_string(dataname)
  checkmate::assert_class(aval_var, "choices_selected")
  checkmate::assert_class(id_var, "choices_selected")
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(visit_var, "choices_selected")
  checkmate::assert_class(cov_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(method, "choices_selected")
  checkmate::assert_class(conf_level, "choices_selected")
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")
  if (inherits(ggplot2_args, "ggplot2_args")) ggplot2_args <- list(default = ggplot2_args)
  plot_choices <- c("lsmeans", "diagnostic")
  checkmate::assert_list(ggplot2_args, types = "ggplot2_args")
  checkmate::assert_subset(names(ggplot2_args), c("default", plot_choices))

  args <- as.list(environment())

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname),
    id_var = cs_to_des_select(id_var, dataname = dataname),
    visit_var = cs_to_des_select(visit_var, dataname = dataname),
    cov_var = cs_to_des_select(cov_var, dataname = dataname, multiple = TRUE),
    split_covariates = cs_to_des_select(split_choices(cov_var), dataname = dataname, multiple = TRUE),
    aval_var = cs_to_des_select(aval_var, dataname = dataname)
  )

  module(
    label = label,
    server = srv_mmrm,
    ui = ui_mmrm,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        arm_ref_comp = arm_ref_comp,
        label = label,
        total_label = total_label,
        plot_height = plot_height,
        plot_width = plot_width,
        basic_table_args = basic_table_args,
        ggplot2_args = ggplot2_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_mmrm <- function(id, ...) {
  a <- list(...) # module args
  ns <- NS(id)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$arm_var,
    a$paramcd,
    a$id_var,
    a$visit_var,
    a$cov_var,
    a$aval_var
  )

  tagList(
    singleton(
      tags$head(includeCSS(system.file("css/custom.css", package = "teal.modules.clinical")))
    ),
    teal.widgets::standard_layout(
      output = teal.widgets::white_small_well(
        textOutput(ns("null_input_msg")),
        tags$h3(textOutput(ns("mmrm_title"))),
        teal.widgets::table_with_settings_ui(ns("mmrm_table")),
        teal.widgets::plot_with_settings_ui(id = ns("mmrm_plot"))
      ),
      encoding = tags$div(
        ### Reporter
        teal.reporter::simple_reporter_ui(ns("simple_reporter")),
        ###
        tags$label("Encodings", class = "text-primary"),
        teal.transform::datanames_input(a[c("arm_var", "paramcd", "id_var", "visit_var", "cov_var", "aval_var")]),
        teal.widgets::panel_group(
          teal.widgets::panel_item(
            "Model Settings",
            teal.transform::data_extract_ui(
              id = ns("aval_var"),
              label = "Analysis Variable",
              data_extract_spec = a$aval_var,
              is_single_dataset = is_single_dataset_value
            ),
            teal.transform::data_extract_ui(
              id = ns("paramcd"),
              label = "Select Endpoint",
              data_extract_spec = a$paramcd,
              is_single_dataset = is_single_dataset_value
            ),
            teal.transform::data_extract_ui(
              id = ns("visit_var"),
              label = "Visit Variable",
              data_extract_spec = a$visit_var,
              is_single_dataset = is_single_dataset_value
            ),
            teal.transform::data_extract_ui(
              id = ns("cov_var"),
              label = "Covariates",
              data_extract_spec = a$cov_var,
              is_single_dataset = is_single_dataset_value
            ),
            shinyjs::hidden(
              teal.transform::data_extract_ui(
                id = ns("split_covariates"),
                label = "Split Covariates",
                data_extract_spec = a$split_covariates,
                is_single_dataset = is_single_dataset_value
              )
            ),
            teal.transform::data_extract_ui(
              id = ns("arm_var"),
              label = "Select Treatment Variable",
              data_extract_spec = a$arm_var,
              is_single_dataset = is_single_dataset_value
            ),
            shinyjs::hidden(uiOutput(ns("arms_buckets"))),
            shinyjs::hidden(
              helpText(
                id = ns("help_text"), "Multiple reference groups are automatically combined into a single group."
              )
            ),
            shinyjs::hidden(
              checkboxInput(
                ns("combine_comp_arms"),
                "Combine all comparison groups?",
                value = FALSE
              )
            ),
            teal.transform::data_extract_ui(
              id = ns("id_var"),
              label = "Subject Identifier",
              data_extract_spec = a$id_var,
              is_single_dataset = is_single_dataset_value
            ),
            selectInput(
              ns("weights_emmeans"),
              "Weights for LS means",
              choices = c("proportional", "equal"),
              selected = "proportional",
              multiple = FALSE
            ),
            selectInput(
              ns("cor_struct"),
              "Correlation Structure",
              choices = eval(formals(tern.mmrm::build_formula)$cor_struct),
              multiple = FALSE
            ),
            teal.widgets::optionalSelectInput(
              ns("method"),
              "Adjustment Method",
              a$method$choices,
              a$method$selected,
              multiple = FALSE,
              fixed = a$method$fixed
            ),
            teal.widgets::optionalSelectInput(
              ns("conf_level"),
              "Confidence Level",
              a$conf_level$choices,
              a$conf_level$selected,
              multiple = FALSE,
              fixed = a$conf_level$fixed
            ),
            checkboxInput(
              ns("parallel"),
              "Parallel Computing",
              value = TRUE
            ),
            collapsed = FALSE # Start with having this panel opened.
          )
        ),
        actionButton(
          ns("button_start"),
          "Fit Model",
          icon = icon("calculator"),
          width = "100%",
          class = "btn action-button text-dark bg-orange mb-4"
        ),
        radioButtons(
          ns("output_function"),
          "Output Type",
          choices = c(
            "LS means table" = "t_mmrm_lsmeans",
            "LS means plots" = "g_mmrm_lsmeans",
            "Covariance estimate" = "t_mmrm_cov",
            "Fixed effects" = "t_mmrm_fixed",
            "Fit statistics" = "t_mmrm_diagnostic",
            "Diagnostic plots" = "g_mmrm_diagnostic"
          ),
          selected = "t_mmrm_lsmeans"
        ),
        conditionalPanel(
          condition = paste0(
            "input['", ns("output_function"), "'] == 't_mmrm_lsmeans'", " || ",
            "input['", ns("output_function"), "'] == 'g_mmrm_lsmeans'", " || ",
            "input['", ns("output_function"), "'] == 'g_mmrm_diagnostic'"
          ),
          teal.widgets::panel_group(
            teal.widgets::panel_item(
              "Output Settings",
              # Additional option for LS means table.
              selectInput(
                ns("t_mmrm_lsmeans_show_relative"),
                "Show Relative Change",
                choices = c("reduction", "increase", "none"),
                selected = "reduction",
                multiple = FALSE
              ),
              checkboxGroupInput(
                ns("g_mmrm_lsmeans_select"),
                "LS means plots",
                choices = c(
                  "Estimates" = "estimates",
                  "Contrasts" = "contrasts"
                ),
                selected = c("estimates", "contrasts"),
                inline = TRUE
              ),
              sliderInput(
                ns("g_mmrm_lsmeans_width"),
                "CI bar width",
                min = 0.1,
                max = 1,
                value = 0.6
              ),
              checkboxInput(
                ns("g_mmrm_lsmeans_contrasts_show_pval"),
                "Show contrasts p-values",
                value = FALSE
              ),
              # Additional options for diagnostic plots.
              radioButtons(
                ns("g_mmrm_diagnostic_type"),
                "Diagnostic plot type",
                choices = c(
                  "Fitted vs. Residuals" = "fit-residual",
                  "Normal Q-Q Plot of Residuals" = "q-q-residual"
                ),
                selected = NULL
              ),
              sliderInput(
                ns("g_mmrm_diagnostic_z_threshold"),
                "Label observations above this threshold",
                min = 0.1,
                max = 10,
                value = 3
              )
            )
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_mmrm <- function(id,
                     data,
                     reporter,
                     filter_panel_api,
                     dataname,
                     parentname,
                     arm_var,
                     paramcd,
                     id_var,
                     visit_var,
                     cov_var,
                     split_covariates,
                     aval_var,
                     arm_ref_comp,
                     label,
                     total_label,
                     plot_height,
                     plot_width,
                     basic_table_args,
                     ggplot2_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    # Reactive responsible for sending a disable/enable signal
    # to show R code and debug info buttons
    disable_r_code <- reactiveVal(FALSE)

    observeEvent(input[[extract_input("cov_var", dataname)]], {
      # update covariates as actual variables
      split_interactions_values <- split_interactions(input[[extract_input("cov_var", dataname)]])
      arm_var_value <- input[[extract_input("arm_var", parentname)]]
      arm_in_cov <- length(intersect(split_interactions_values, arm_var_value)) >= 1L
      if (arm_in_cov) {
        split_covariates_selected <- setdiff(split_interactions_values, arm_var_value)
      } else {
        split_covariates_selected <- split_interactions_values
      }
      teal.widgets::updateOptionalSelectInput(
        session,
        inputId = extract_input("split_covariates", dataname),
        selected = split_covariates_selected
      )
    })

    arm_ref_comp_iv <- arm_ref_comp_observer(
      session,
      input,
      output,
      id_arm_var = extract_input("arm_var", parentname), # From UI.
      data = reactive(data()[[parentname]]),
      arm_ref_comp = arm_ref_comp,
      module = "tm_mmrm"
    )

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        arm_var = arm_var,
        paramcd = paramcd,
        id_var = id_var,
        visit_var = visit_var,
        split_covariates = split_covariates,
        cov_var = cov_var, # only needed for validation see selector_list_without_cov reactive
        aval_var = aval_var
      ),
      datasets = data,
      select_validation_rule = list(
        aval_var = shinyvalidate::sv_required("'Analysis Variable' field is not selected"),
        visit_var = shinyvalidate::sv_required("'Visit Variable' field is not selected"),
        arm_var = shinyvalidate::sv_required("'Treatment Variable' field is not selected"),
        id_var = shinyvalidate::sv_required("'Subject Identifier' field is not selected"),
        # validation on cov_var
        cov_var = function(value) {
          if (length(selector_list()$visit_var()$select) == 0) {
            return(NULL)
          }
          if ("BASE:AVISIT" %in% value && selector_list()$visit_var()$select == "AVISITN") {
            paste(
              "'BASE:AVISIT' is not a valid covariate when 'AVISITN' is selected as visit variable.",
              "Please deselect 'BASE:AVISIT' as a covariate or change visit variable to 'AVISIT'."
            )
          } else if ("BASE:AVISITN" %in% value && selector_list()$visit_var()$select == "AVISIT") {
            paste(
              "'BASE:AVISITN' is not a valid covariate when 'AVISIT' is selected as visit variable.",
              "Please deselect 'BASE:AVISITN' as a covariate or change visit variable to 'AVISITN'."
            )
          }
        }
      ),
      filter_validation_rule = list(
        paramcd = shinyvalidate::sv_required("'Select Endpoint' field is not selected")
      )
    )

    # selector_list includes cov_var as it is needed for validation rules
    # but not needed to merge so it is removed here
    selector_list_without_cov <- reactive({
      selector_list()[names(selector_list()) != "cov_var"]
    })

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_validator(arm_ref_comp_iv)
      iv$add_rule("conf_level", shinyvalidate::sv_required("'Confidence Level' field is not selected"))
      iv$add_rule(
        "conf_level",
        shinyvalidate::sv_between(
          0, 1,
          message_fmt = "Confidence level must be between 0 and 1"
        )
      )
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list_without_cov,
      merge_function = "dplyr::inner_join"
    )

    adsl_merge_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(code = as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(code = as.expression(adsl_merge_inputs()$expr))
    })

    # Initially hide the output title because there is no output yet.
    shinyjs::hide("mmrm_title")

    # reactiveVal used to send a signal to plot_with_settings module to hide the UI
    show_plot_rv <- reactiveVal(FALSE)

    # this will store the current/last state of inputs and data that generated a model-fit
    # its purpose is to allow any input change to be checked whether it resulted in an out of sync state
    state <- reactiveValues(input = NULL, button_start = 0)

    # Note:
    # input$parallel does not get us out of sync (it just takes longer to get to same result)
    sync_inputs <- c(
      extract_input("aval_var", dataname),
      extract_input("paramcd", dataname, filter = TRUE),
      extract_input("arm_var", parentname),
      "Ref",
      "Comp",
      "combine_comp_arms",
      extract_input("visit_var", dataname),
      extract_input("cov_var", dataname),
      extract_input("id_var", dataname),
      "weights_emmeans",
      "cor_struct",
      "method",
      "conf_level"
    )

    # Setup arm variable selection, default reference arms, and default
    # comparison arms for encoding panel.

    observeEvent(adsl_merge_inputs()$columns_source$arm_var, {
      arm_var <- as.vector(adsl_merge_inputs()$columns_source$arm_var)
      if (length(arm_var) == 0) {
        shinyjs::hide("arms_buckets")
        shinyjs::hide("help_text")
        shinyjs::hide("combine_comp_arms")
      } else {
        shinyjs::show("arms_buckets")
        shinyjs::show("help_text")
        shinyjs::show("combine_comp_arms")
      }
    })

    # Event handler:
    # Show either the plot or the table output.
    observeEvent(input$output_function, {
      output_function <- input$output_function
      if (isTRUE(grepl("^t_", output_function))) {
        show_plot_rv(FALSE)
        shinyjs::show("mmrm_table")
      } else if (isTRUE(grepl("^g_", output_function))) {
        shinyjs::hide("mmrm_table")
        show_plot_rv(TRUE)
      } else {
        stop("unknown output type")
      }
    })

    # Event handler:
    # Show or hide LS means table option.
    observeEvent(input$output_function, {
      output_function <- input$output_function
      if (isTRUE(output_function == "t_mmrm_lsmeans")) {
        shinyjs::show("t_mmrm_lsmeans_show_relative")
      } else {
        shinyjs::hide("t_mmrm_lsmeans_show_relative")
      }
    })

    # Event handler:
    # Show or hide the LS means plot options.
    observeEvent(list(input$output_function, input$g_mmrm_lsmeans_select), {
      output_function <- input$output_function
      g_mmrm_lsmeans_select <- input$g_mmrm_lsmeans_select
      if (isTRUE(output_function == "g_mmrm_lsmeans")) {
        shinyjs::show("g_mmrm_lsmeans_select")
        shinyjs::show("g_mmrm_lsmeans_width")
        if (isTRUE("contrasts" %in% g_mmrm_lsmeans_select)) {
          shinyjs::show("g_mmrm_lsmeans_contrasts_show_pval")
        } else {
          shinyjs::hide("g_mmrm_lsmeans_contrasts_show_pval")
        }
      } else {
        shinyjs::hide("g_mmrm_lsmeans_select")
        shinyjs::hide("g_mmrm_lsmeans_width")
        shinyjs::hide("g_mmrm_lsmeans_contrasts_show_pval")
      }
    })

    # Event handler:
    # Show or hide the diagnostic plot type option.
    observeEvent(list(input$output_function, input$g_mmrm_diagnostic_type), {
      output_function <- input$output_function
      g_mmrm_diagnostic_type <- input$g_mmrm_diagnostic_type
      if (isTRUE(output_function == "g_mmrm_diagnostic")) {
        shinyjs::show("g_mmrm_diagnostic_type")
        if (isTRUE(g_mmrm_diagnostic_type == "q-q-residual")) {
          shinyjs::show("g_mmrm_diagnostic_z_threshold")
        } else {
          shinyjs::hide("g_mmrm_diagnostic_z_threshold")
        }
      } else {
        shinyjs::hide("g_mmrm_diagnostic_type")
        shinyjs::hide("g_mmrm_diagnostic_z_threshold")
      }
    })

    # Event handler:
    # When the "Fit Model" button is clicked, hide initial message, show title, disable model fit and enable
    # show R code buttons.
    shinyjs::onclick("button_start", {
      state$input <- mmrm_inputs_reactive()
      shinyjs::hide("null_input_msg")
      shinyjs::disable("button_start")
      success <- try(mmrm_fit(), silent = TRUE)
      if (!inherits(success, "try-error")) {
        shinyjs::show("mmrm_title")
        disable_r_code(FALSE)
      } else {
        shinyjs::hide("mmrm_title")
        # show R code and debug info buttons will have already been hidden by disable_r_code
      }
    })

    # all the inputs and data that can be out of sync with the fitted model
    mmrm_inputs_reactive <- reactive({
      shinyjs::disable("button_start")
      disable_r_code(TRUE)
      teal::validate_inputs(iv_r())
      encoding_inputs <- lapply(
        sync_inputs,
        function(x) {
          if (x %in% c("Ref", "Comp")) {
            unlist(input$buckets[[x]])
          } else {
            input[[x]]
          }
        }
      )
      names(encoding_inputs) <- sync_inputs

      adsl_filtered <- anl_q()[["ADSL"]]
      anl_filtered <- anl_q()[[dataname]]

      teal::validate_has_data(adsl_filtered, min_nrow = 1)
      teal::validate_has_data(anl_filtered, min_nrow = 1)
      validate_checks()
      c(list(adsl_filtered = adsl_filtered, anl_filtered = anl_filtered), encoding_inputs)
    })

    output$null_input_msg <- renderText({
      mmrm_inputs_reactive()
      paste(
        "Please first specify 'Model Settings' and press 'Fit Model'.",
        "Afterwards choose 'Output Type' and optional 'Output Settings'.",
        "If changes to the 'Model Settings' or dataset (by filtering) are made,",
        "then the 'Fit Model' button must be pressed again to update the MMRM model.",
        "Note that the 'Show R Code' button can only be clicked if the model fit is up to date."
      )
    })

    # compares the mmrm_inputs_reactive values with the values stored in 'state'
    state_has_changed <- reactive({
      req(state$input)
      displayed_state <- mmrm_inputs_reactive()
      equal_ADSL <- all.equal(state$input$adsl_filtered, displayed_state$adsl_filtered) # nolint: object_name.
      equal_dataname <- all.equal(state$input$anl_filtered, displayed_state$anl_filtered)
      true_means_change <- vapply(
        sync_inputs,
        FUN = function(x) {
          if (is.null(state$input[[x]])) {
            if (is.null(displayed_state[[x]])) {
              return(FALSE)
            } else {
              return(TRUE)
            }
          } else if (is.null(displayed_state[[x]])) {
            return(TRUE)
          }
          if (length(state$input[[x]]) != length(displayed_state[[x]])) {
            return(TRUE)
          }
          any(sort(state$input[[x]]) != sort(displayed_state[[x]]))
        },
        FUN.VALUE = logical(1)
      )

      # all.equal function either returns TRUE or a character scalar to describe where there is inequality
      any(c(is.character(equal_ADSL), is.character(equal_dataname), true_means_change))
    })

    # Event handler:
    # These trigger when we are out of sync and then enable the start button and
    # disable the show R code button and show warning message
    observeEvent(mmrm_inputs_reactive(), {
      shinyjs::enable("button_start")
      disable_r_code(TRUE)
      if (!state_has_changed()) {
        disable_r_code(FALSE)
        shinyjs::disable("button_start")
      }
    })

    # Prepare the analysis environment (filter data, check data, populate envir).
    validate_checks <- reactive({
      adsl_filtered <- anl_q()[[parentname]]
      anl_filtered <- anl_q()[[dataname]]
      anl_data <- anl_q()[["ANL"]]

      anl_m_inputs <- anl_inputs()
      if (!is.null(input[[extract_input("arm_var", parentname)]])) {
        input_arm_var <- as.vector(anl_m_inputs$columns_source$arm_var)
      } else {
        input_arm_var <- NULL
      }
      input_visit_var <- as.vector(anl_m_inputs$columns_source$visit_var)

      input_aval_var <- as.vector(anl_m_inputs$columns_source$aval_var)
      input_id_var <- as.vector(anl_m_inputs$columns_source$id_var)
      input_paramcd <- unlist(paramcd$filter)["vars_selected"]

      # Split the existing covariate strings in their variable parts, to allow "A*B" and "A:B" notations.
      input_cov_var <- as.vector(anl_m_inputs$columns_source$split_covariates)
      covariate_parts <- split_interactions(input_cov_var)

      all_x_vars <- c(input_arm_var, input_visit_var, covariate_parts)

      all_x_vars_in_adsl <- intersect(
        all_x_vars,
        colnames(adsl_filtered)
      )
      all_x_vars_in_anl <- setdiff(
        all_x_vars,
        all_x_vars_in_adsl
      )

      adslvars <- unique(c("USUBJID", "STUDYID", input_arm_var, input_id_var, all_x_vars_in_adsl))
      anlvars <- unique(c("USUBJID", "STUDYID", input_paramcd, input_aval_var, input_visit_var, all_x_vars_in_anl))

      validate_standard_inputs(
        adsl = adsl_filtered,
        adslvars = adslvars,
        anl = anl_filtered,
        anlvars = anlvars,
        arm_var = input_arm_var,
        ref_arm = unlist(input$buckets$Ref),
        comp_arm = unlist(input$buckets$Comp),
        min_nrow = 10,
        need_arm = FALSE
      )

      Map(
        function(visit_df, visit_name) {
          dup <- any(duplicated(visit_df[[input_id_var]]))
          validate(need(!dup, paste("Duplicated subject ID found at", visit_name)))
        },
        split(anl_data, anl_data[[input_visit_var]]),
        levels(anl_data[[input_visit_var]])
      )
    })

    # Connector:
    # Fit the MMRM, once the user clicks on the start button.
    mmrm_fit <- eventReactive(input$button_start, {
      qenv <- anl_q()
      anl_m_inputs <- anl_inputs()

      my_calls <- template_fit_mmrm(
        parentname = "ANL_ADSL",
        dataname = "ANL",
        aval_var = as.vector(anl_m_inputs$columns_source$aval_var),
        arm_var = input[[extract_input("arm_var", parentname)]],
        ref_arm = unlist(input$buckets$Ref),
        comp_arm = unlist(input$buckets$Comp),
        combine_comp_arms = input$combine_comp_arms,
        id_var = as.vector(anl_m_inputs$columns_source$id_var),
        visit_var = as.vector(anl_m_inputs$columns_source$visit_var),
        cov_var = input[[extract_input("cov_var", dataname)]],
        conf_level = as.numeric(input$conf_level),
        method = as.character(input$method),
        cor_struct = input$cor_struct,
        weights_emmeans = input$weights_emmeans,
        parallel = input$parallel
      )
      teal.code::eval_code(qenv, as.expression(my_calls))
    })

    output$mmrm_title <- renderText({
      new_inputs <- try(state_has_changed(), silent = TRUE)
      # No message needed here because it will be displayed by either plots or tables output
      validate(need(!inherits(new_inputs, "try-error") && !new_inputs, character(0)))

      # Input on output type.
      output_function <- input$output_function
      g_mmrm_diagnostic_type <- input$g_mmrm_diagnostic_type
      g_mmrm_lsmeans_select <- input$g_mmrm_lsmeans_select

      output_title <- switch(output_function,
        "t_mmrm_cov" = "Residual Covariance Matrix Estimate",
        "t_mmrm_diagnostic" = "Model Fit Statistics",
        "t_mmrm_fixed" = "Fixed Effects Estimates",
        "t_mmrm_lsmeans" = "LS Means and Contrasts Estimates",
        "g_mmrm_diagnostic" = switch(g_mmrm_diagnostic_type,
          "fit-residual" = "Marginal Fitted Values vs. Residuals",
          "q-q-residual" = "Q-Q Normal Plot for Standardized Residuals"
        ),
        "g_mmrm_lsmeans" = if (setequal(g_mmrm_lsmeans_select, c("estimates", "contrasts"))) {
          "LS Means Estimates and Contrasts"
        } else if (identical(g_mmrm_lsmeans_select, "estimates")) {
          "LS Means Estimates"
        } else {
          "LS Means Contrasts"
        }
      )
      output_title
    })

    table_q <- reactive({
      validate(
        need(
          !state_has_changed(),
          "Inputs changed and no longer reflect the fitted model. Press `Fit Model` button again to re-fit model."
        )
      )
      # Input on output type.
      output_function <- input$output_function

      # If the output is not a table, stop here.
      if (!isTRUE(grepl("^t_", output_function))) {
        return(NULL)
      }
      # Get the fit stack while evaluating the fit code at the same time.
      qenv <- mmrm_fit()
      fit <- qenv[["fit"]]

      anl_m_inputs <- anl_inputs()

      ANL <- qenv[["ANL"]]
      ANL_ADSL <- qenv[["ANL_ADSL"]]
      paramcd <- unique(ANL[[unlist(paramcd$filter)["vars_selected"]]])

      basic_table_args$subtitles <- paste0(
        "Analysis Variable: ", anl_m_inputs$columns_source$aval_var,
        ",  Endpoint: ", anl_m_inputs$filter_info$paramcd[[1]]$selected[[1]],
        ifelse(is.null(fit$vars$covariates), "", paste(",  Covariates:", paste(fit$vars$covariates, collapse = ", ")))
      )
      basic_table_args$main_footer <- c(
        paste("Weights for LS Means:", input$weights_emmeans),
        paste("Correlation Structure:", input$cor_struct),
        paste("Adjustment Method:", input$method)
      )

      mmrm_table <- template_mmrm_tables(
        parentname = "ANL_ADSL",
        dataname = "ANL",
        fit_name = "fit",
        arm_var = input[[extract_input("arm_var", parentname)]],
        ref_arm = unlist(input$buckets$Ref),
        visit_var = as.vector(anl_m_inputs$columns_source$visit_var),
        paramcd = paramcd,
        show_relative = input$t_mmrm_lsmeans_show_relative,
        table_type = output_function,
        total_label = total_label,
        basic_table_args = basic_table_args
      )

      teal.code::eval_code(qenv, as.expression(mmrm_table))
    })

    # Endpoint:
    # Plot outputs.
    plot_q <- reactive({
      validate(
        need(
          !state_has_changed(),
          "Inputs changed and no longer reflect the fitted model. Press `Fit Model` button again to re-fit model."
        )
      )
      # Input on output type.
      output_function <- input$output_function

      # Stop here if the output is not a plot.
      if (!isTRUE(grepl("^g_", output_function))) {
        return(NULL)
      }

      qenv <- mmrm_fit()
      fit <- qenv[["fit"]]

      ggplot2_args[["lsmeans"]] <- teal.widgets::ggplot2_args(
        labs <- list(
          subtitle = paste0(
            "Endpoint: ", fit$fit$data$PARAMCD[1],
            ifelse(is.null(fit$vars$covariates), "",
              paste(",  Covariates:", paste(fit$vars$covariates, collapse = ", "))
            )
          ),
          caption = paste(
            paste("Weights for LS Means:", input$weights_emmeans),
            paste("Correlation Structure:", input$cor_struct),
            paste("Adjustment Method:", input$method),
            sep = "\n"
          )
        )
      )

      ggplot2_args[["default"]] <- teal.widgets::ggplot2_args(
        labs <- list(
          subtitle = paste0(
            "Analysis Variable: ", fit$vars$response,
            ",  Endpoint: ", fit$fit$data$PARAMCD[1]
          )
        )
      )

      lsmeans_args <- if (output_function == "g_mmrm_lsmeans") {
        list(
          select = input$g_mmrm_lsmeans_select,
          width = input$g_mmrm_lsmeans_width,
          show_pval = input$g_mmrm_lsmeans_contrasts_show_pval
        )
      }

      diagnostic_args <- if (output_function == "g_mmrm_diagnostic") {
        list(
          type = input$g_mmrm_diagnostic_type,
          z_threshold = input$g_mmrm_diagnostic_z_threshold
        )
      }

      mmrm_plot_expr <- template_mmrm_plots(
        fit_name = "fit",
        lsmeans_plot = lsmeans_args,
        diagnostic_plot = diagnostic_args,
        ggplot2_args = ggplot2_args
      )
      teal.code::eval_code(qenv, as.expression(mmrm_plot_expr))
    })

    all_q <- reactive({
      if (!is.null(plot_q()) && !is.null(table_q())) {
        teal.code::join(plot_q(), table_q())
      } else if (!is.null(plot_q())) {
        plot_q()
      } else {
        table_q()
      }
    })

    table_r <- reactive({
      switch(input$output_function,
        t_mmrm_lsmeans = table_q()[["lsmeans_table"]],
        t_mmrm_diagnostic = table_q()[["diagnostic_table"]],
        t_mmrm_fixed = table_q()[["fixed_effects"]],
        t_mmrm_cov = table_q()[["cov_matrix"]]
      )
    })

    plot_r <- reactive({
      switch(input$output_function,
        g_mmrm_lsmeans = plot_q()[["lsmeans_plot"]],
        g_mmrm_diagnostic = plot_q()[["diagnostic_plot"]]
      )
    })

    pws <- teal.widgets::plot_with_settings_srv(
      id = "mmrm_plot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width,
      show_hide_signal = reactive(show_plot_rv())
    )

    teal.widgets::table_with_settings_srv(
      id = "mmrm_table",
      table_r = table_r,
      show_hide_signal = reactive(!show_plot_rv())
    )

    # Show R code once button is pressed.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      disabled = disable_r_code,
      title = "R Code for the Current MMRM Analysis"
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Mixed Model Repeated Measurements (MMRM) Analysis",
          label = label,
          description = paste(
            "Mixed Models procedure analyzes results from repeated measures designs",
            "in which the outcome is continuous and measured at fixed time points"
          ),
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        if (!is.null(table_r())) {
          card$append_text("Table", "header3")
          card$append_table(table_r())
        }
        if (!is.null(plot_r())) {
          card$append_text("Plot", "header3")
          card$append_plot(plot_r(), dim = pws$dim())
        }
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Patient Profile Therapy Table and Plot
#'
#' Creates a valid expression to generate a patient profile therapy table and [ggplot2::ggplot()] plot using ADaM
#' datasets.
#'
#' @inheritParams template_arguments
#' @param cmdose (`character`)\cr name of dose per administration variable.
#' @param cmtrt (`character`)\cr name of reported name of drug, med, or therapy variable.
#' @param cmdosu (`character`)\cr name of dose units variable.
#' @param cmroute (`character`)\cr name of route of administration variable.
#' @param cmdosfrq (`character`)\cr name of dosing frequency per interval variable.
#' @param cmendy (`character`)\cr name of study day of end of medication variable.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_g_pp_therapy()]
#'
#' @keywords internal
template_therapy <- function(dataname = "ANL",
                             atirel = "ATIREL",
                             cmdecod = "CMDECOD",
                             cmindc = "CMINDC",
                             cmdose = "CMDOSE",
                             cmtrt = "CMTRT",
                             cmdosu = "CMDOSU",
                             cmroute = "CMROUTE",
                             cmdosfrq = "CMDOSFRQ",
                             cmstdy = "CMSTDY",
                             cmendy = "CMENDY",
                             patient_id,
                             font_size = 12L,
                             ggplot2_args = teal.widgets::ggplot2_args()) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(atirel)
  checkmate::assert_string(cmdecod)
  checkmate::assert_string(cmindc)
  checkmate::assert_string(cmdose)
  checkmate::assert_string(cmtrt)
  checkmate::assert_string(cmdosu)
  checkmate::assert_string(cmroute)
  checkmate::assert_string(cmdosfrq)
  checkmate::assert_string(cmstdy)
  checkmate::assert_string(cmendy)
  checkmate::assert_string(patient_id)
  checkmate::assert_number(font_size)

  y <- list()
  y$table_list <- list()
  y$plot_list <- list()

  table_list <- add_expr(
    list(),
    substitute(expr = {
      cols_to_include <- c(
        cmindc_char,
        cmdecod_char,
        cmdose_char,
        cmtrt_char,
        cmdosu_char,
        cmroute_char,
        cmdosfrq_char,
        cmstdy_char,
        cmendy_char
      )

      dataname[setdiff(cols_to_include, names(dataname))] <- NA

      therapy_table <- dataname %>%
        dplyr::filter(atirel %in% c("CONCOMITANT", "PRIOR")) %>% # removed PRIOR_CONCOMITANT
        dplyr::select(dplyr::all_of(cols_to_include)) %>%
        dplyr::filter(!is.na(cmdecod)) %>%
        dplyr::mutate(Dosage = paste(cmdose, cmdosu, cmdosfrq, cmroute)) %>%
        dplyr::select(-cmdose, -cmdosu, -cmdosfrq, -cmroute) %>%
        dplyr::select(cmindc, cmdecod, Dosage, dplyr::everything()) %>%
        dplyr::mutate(!!cmdecod_char := dplyr::case_when(
          nchar(as.character(cmdecod)) > 20 ~ as.character(cmtrt),
          TRUE ~ as.character(cmdecod)
        )) %>%
        dplyr::select(-cmtrt) %>%
        dplyr::arrange(cmindc, cmdecod, cmstdy) %>%
        dplyr::distinct() %>%
        `colnames<-`(c(
          col_labels(dataname, fill = TRUE)[c(cmindc_char, cmdecod_char)], "Dosage",
          col_labels(dataname, fill = TRUE)[c(cmstdy_char, cmendy_char)]
        ))

      therapy_table <- rlistings::as_listing(
        therapy_table,
        key_cols = NULL,
        default_formatting = list(all = fmt_config(align = "left"))
      )
      main_title(therapy_table) <- paste("Patient ID:", patient_id)

      therapy_table
    }, env = list(
      dataname = as.name(dataname),
      atirel = as.name(atirel),
      cmdecod = as.name(cmdecod),
      cmindc = as.name(cmindc),
      cmdose = as.name(cmdose),
      cmtrt = as.name(cmtrt),
      cmdosu = as.name(cmdosu),
      cmroute = as.name(cmroute),
      cmdosfrq = as.name(cmdosfrq),
      cmstdy = as.name(cmstdy),
      cmendy = as.name(cmendy),
      cmdecod_char = cmdecod,
      cmindc_char = cmindc,
      cmdose_char = cmdose,
      cmtrt_char = cmtrt,
      cmdosu_char = cmdosu,
      cmroute_char = cmroute,
      cmdosfrq_char = cmdosfrq,
      cmendy_char = cmendy,
      cmstdy_char = cmstdy,
      patient_id = patient_id
    ))
  )

  parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args(
    teal.widgets::resolve_ggplot2_args(
      user_plot = ggplot2_args,
      module_plot = teal.widgets::ggplot2_args(
        labs = list(y = "Medication", title = paste0("Patient ID: ", patient_id)),
        theme = list(
          text = substitute(ggplot2::element_text(size = font), list(font = font_size)),
          axis.text.y = quote(ggplot2::element_blank()),
          axis.ticks.y = quote(ggplot2::element_blank()),
          plot.title = substitute(ggplot2::element_text(size = font), list(font = font_size)),
          legend.position = "none",
          panel.grid.minor = quote(ggplot2::element_line(
            linewidth = 0.5,
            linetype = "dotted",
            colour = "grey"
          )),
          panel.grid.major = quote(ggplot2::element_line(
            linewidth = 0.5,
            linetype = "dotted",
            colour = "grey"
          ))
        )
      )
    ),
    ggtheme = "minimal"
  )

  plot_list <- add_expr(
    list(),
    substitute(expr = {
      dataname[[cmstdy_char]] <- as.numeric(dataname[[cmstdy_char]])
      dataname[[cmendy_char]] <- as.numeric(dataname[[cmendy_char]])
      max_day <- max(dataname[[cmendy_char]], na.rm = TRUE)
      data <- dataname %>%
        dplyr::filter(atirel %in% c("CONCOMITANT", "PRIOR")) %>% # remove PRIOR_CONCOMITANT
        dplyr::select_at(cols_to_include) %>%
        dplyr::filter(!is.na(cmdecod)) %>%
        dplyr::mutate(DOSE = paste(cmdose, cmdosu, cmdosfrq)) %>%
        dplyr::select(-cmdose, -cmdosu, -cmdosfrq) %>%
        dplyr::select(cmindc, cmdecod, DOSE, dplyr::everything()) %>%
        dplyr::arrange(cmindc, cmdecod, cmstdy) %>%
        dplyr::distinct() %>%
        dplyr::mutate(CMSTDY = dplyr::case_when(
          is.na(cmstdy) ~ 1,
          TRUE ~ cmstdy
        )) %>%
        dplyr::mutate(CMENDY = dplyr::case_when(
          is.na(cmendy) ~ max_day,
          TRUE ~ cmendy
        )) %>%
        dplyr::arrange(CMSTDY, dplyr::desc(CMSTDY)) %>%
        dplyr::mutate(CMDECOD = dplyr::case_when(
          nchar(as.character(cmdecod)) > 20 ~ as.character(cmtrt),
          TRUE ~ as.character(cmdecod)
        ))

      therapy_plot <-
        ggplot2::ggplot(data = data, ggplot2::aes(fill = cmindc, color = cmindc, y = CMDECOD, x = CMSTDY)) +
        ggplot2::geom_segment(ggplot2::aes(xend = CMENDY, yend = CMDECOD), size = 2) +
        ggplot2::geom_text(
          data = data %>%
            dplyr::select(CMDECOD, cmindc, CMSTDY) %>%
            dplyr::distinct(),
          ggplot2::aes(x = CMSTDY, label = CMDECOD), color = "black",
          hjust = "left",
          vjust = "bottom",
          nudge_y = 0.1,
          size = font_size_var / 3.5
        ) +
        ggplot2::scale_y_discrete(expand = ggplot2::expansion(add = 1.2)) +
        ggplot2::geom_point(color = "black", size = 2, shape = 24, position = ggplot2::position_nudge(y = -0.15)) +
        labs +
        ggtheme +
        theme

      print(therapy_plot)
    }, env = c(
      list(
        dataname = as.name(dataname),
        atirel = as.name(atirel),
        cmdecod = as.name(cmdecod),
        cmindc = as.name(cmindc),
        cmdose = as.name(cmdose),
        cmtrt = as.name(cmtrt),
        cmdosu = as.name(cmdosu),
        cmroute = as.name(cmroute),
        cmdosfrq = as.name(cmdosfrq),
        cmstdy = as.name(cmstdy),
        cmendy = as.name(cmendy),
        cmdecod_char = cmdecod,
        cmindc_char = cmindc,
        cmdose_char = cmdose,
        cmtrt_char = cmtrt,
        cmdosu_char = cmdosu,
        cmroute_char = cmroute,
        cmdosfrq_char = cmdosfrq,
        cmstdy_char = cmstdy,
        cmendy_char = cmendy,
        patient_id = patient_id,
        font_size_var = font_size
      ),
      parsed_ggplot2_args
    ))
  )
  y$table_list <- bracket_expr(table_list)
  y$plot_list <- bracket_expr(plot_list)
  y
}

#' teal Module: Patient Profile Therapy Table and Plot
#'
#' This module produces a patient profile therapy table and [ggplot2::ggplot()] type plot using ADaM datasets.
#'
#' @inheritParams module_arguments
#' @inheritParams template_therapy
#' @param cmdose ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `CMDOSE` variable from `dataname`.
#' @param cmtrt ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `CMTRT` variable from `dataname`.
#' @param cmdosu ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `CMDOSU` variable from `dataname`.
#' @param cmroute ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `CMROUTE` variable from `dataname`.
#' @param cmdosfrq ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `CMDOSFRQ` variable from `dataname`.
#' @param cmendy ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `CMENDY` variable from `dataname`.
#'
#' @inherit module_arguments return
#'
#' @examples
#' library(nestcolor)
#' library(dplyr)
#'
#' ADCM <- tmc_ex_adcm
#' ADSL <- tmc_ex_adsl %>% filter(USUBJID %in% ADCM$USUBJID)
#' ADCM$CMASTDTM <- ADCM$ASTDTM
#' ADCM$CMAENDTM <- ADCM$AENDTM
#' adcm_keys <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4")
#'
#' join_keys <- default_cdisc_join_keys[c("ADSL", "ADCM")]
#' join_keys["ADCM", "ADCM"] <- adcm_keys
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADCM = ADCM,
#'     code = "
#'       ADCM <- tmc_ex_adcm
#'       ADSL <- tmc_ex_adsl %>% filter(USUBJID %in% ADCM$USUBJID)
#'       ADCM$CMASTDTM <- ADCM$ASTDTM
#'       ADCM$CMAENDTM <- ADCM$AENDTM
#'     ",
#'     join_keys = join_keys
#'   ),
#'   modules = modules(
#'     tm_g_pp_therapy(
#'       label = "Therapy",
#'       dataname = "ADCM",
#'       parentname = "ADSL",
#'       patient_col = "USUBJID",
#'       plot_height = c(600L, 200L, 2000L),
#'       atirel = choices_selected(
#'         choices = variable_choices(ADCM, "ATIREL"),
#'         selected = c("ATIREL")
#'       ),
#'       cmdecod = choices_selected(
#'         choices = variable_choices(ADCM, "CMDECOD"),
#'         selected = "CMDECOD"
#'       ),
#'       cmindc = choices_selected(
#'         choices = variable_choices(ADCM, "CMINDC"),
#'         selected = "CMINDC"
#'       ),
#'       cmdose = choices_selected(
#'         choices = variable_choices(ADCM, "CMDOSE"),
#'         selected = "CMDOSE"
#'       ),
#'       cmtrt = choices_selected(
#'         choices = variable_choices(ADCM, "CMTRT"),
#'         selected = "CMTRT"
#'       ),
#'       cmdosu = choices_selected(
#'         choices = variable_choices(ADCM, "CMDOSU"),
#'         selected = c("CMDOSU")
#'       ),
#'       cmroute = choices_selected(
#'         choices = variable_choices(ADCM, "CMROUTE"),
#'         selected = "CMROUTE"
#'       ),
#'       cmdosfrq = choices_selected(
#'         choices = variable_choices(ADCM, "CMDOSFRQ"),
#'         selected = "CMDOSFRQ"
#'       ),
#'       cmstdy = choices_selected(
#'         choices = variable_choices(ADCM, "ASTDY"),
#'         selected = "ASTDY"
#'       ),
#'       cmendy = choices_selected(
#'         choices = variable_choices(ADCM, "AENDY"),
#'         selected = "AENDY"
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_g_pp_therapy <- function(label,
                            dataname = "ADCM",
                            parentname = "ADSL",
                            patient_col = "USUBJID",
                            atirel = NULL,
                            cmdecod = NULL,
                            cmindc = NULL,
                            cmdose = NULL,
                            cmtrt = NULL,
                            cmdosu = NULL,
                            cmroute = NULL,
                            cmdosfrq = NULL,
                            cmstdy = NULL,
                            cmendy = NULL,
                            font_size = c(12L, 12L, 25L),
                            plot_height = c(700L, 200L, 2000L),
                            plot_width = NULL,
                            pre_output = NULL,
                            post_output = NULL,
                            ggplot2_args = teal.widgets::ggplot2_args()) {
  message("Initializing tm_g_pp_therapy")
  checkmate::assert_class(atirel, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(cmdecod, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(cmindc, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(cmdose, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(cmtrt, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(cmdosu, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(cmroute, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(cmdosfrq, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(cmstdy, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(cmendy, "choices_selected", null.ok = TRUE)
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(patient_col)
  checkmate::assert_numeric(font_size, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(font_size[1], lower = font_size[2], upper = font_size[3], .var.name = "font_size")
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(ggplot2_args, "ggplot2_args")

  args <- as.list(environment())
  data_extract_list <- list(
    atirel = `if`(is.null(atirel), NULL, cs_to_des_select(atirel, dataname = dataname)),
    cmdecod = `if`(is.null(cmdecod), NULL, cs_to_des_select(cmdecod, dataname = dataname)),
    cmindc = `if`(is.null(cmindc), NULL, cs_to_des_select(cmindc, dataname = dataname)),
    cmdose = `if`(is.null(cmdose), NULL, cs_to_des_select(cmdose, dataname = dataname)),
    cmtrt = `if`(is.null(cmtrt), NULL, cs_to_des_select(cmtrt, dataname = dataname)),
    cmdosu = `if`(is.null(cmdosu), NULL, cs_to_des_select(cmdosu, dataname = dataname)),
    cmdosfrq = `if`(is.null(cmdosfrq), NULL, cs_to_des_select(cmdosfrq, dataname = dataname)),
    cmroute = `if`(is.null(cmroute), NULL, cs_to_des_select(cmroute, dataname = dataname)),
    cmstdy = `if`(is.null(cmstdy), NULL, cs_to_des_select(cmstdy, dataname = dataname)),
    cmendy = `if`(is.null(cmendy), NULL, cs_to_des_select(cmendy, dataname = dataname))
  )

  module(
    label = label,
    ui = ui_g_therapy,
    ui_args = c(data_extract_list, args),
    server = srv_g_therapy,
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        patient_col = patient_col,
        plot_height = plot_height,
        plot_width = plot_width,
        ggplot2_args = ggplot2_args
      )
    ),
    datanames = c(dataname, parentname)
  )
}

#' @keywords internal
ui_g_therapy <- function(id, ...) {
  ui_args <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    ui_args$atirel,
    ui_args$cmdecod,
    ui_args$cmindc,
    ui_args$cmdose,
    ui_args$cmtrt,
    ui_args$cmdosu,
    ui_args$cmdosfrq,
    ui_args$cmroute,
    ui_args$cmstdy,
    ui_args$cmendy
  )

  ns <- NS(id)
  teal.widgets::standard_layout(
    output = tags$div(
      htmlOutput(ns("title")),
      teal.widgets::get_dt_rows(ns("therapy_table"), ns("therapy_table_rows")),
      DT::DTOutput(outputId = ns("therapy_table")),
      teal.widgets::plot_with_settings_ui(id = ns("therapy_plot"))
    ),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(ui_args[c(
        "atirel", "cmdecod", "cmindc", "cmdose", "cmtrt",
        "cmdosu", "cmroute", "cmdosfrq", "cmstdy", "cmendy"
      )]),
      teal.widgets::optionalSelectInput(
        ns("patient_id"),
        "Select Patient:",
        multiple = FALSE,
        options = shinyWidgets::pickerOptions(`liveSearch` = TRUE)
      ),
      teal.transform::data_extract_ui(
        id = ns("cmdecod"),
        label = "Select the medication decoding column:",
        data_extract_spec = ui_args$cmdecod,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("atirel"),
        label = "Select ATIREL variable:",
        data_extract_spec = ui_args$atirel,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("cmindc"),
        label = "Select CMINDC variable:",
        data_extract_spec = ui_args$cmindc,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("cmdose"),
        label = "Select CMDOSE variable:",
        data_extract_spec = ui_args$cmdose,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("cmtrt"),
        label = "Select CMTRT variable:",
        data_extract_spec = ui_args$cmtrt,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("cmdosu"),
        label = "Select CMDOSU variable:",
        data_extract_spec = ui_args$cmdosu,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("cmroute"),
        label = "Select CMROUTE variable:",
        data_extract_spec = ui_args$cmroute,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("cmdosfrq"),
        label = "Select CMDOSFRQ variable:",
        data_extract_spec = ui_args$cmdosfrq,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("cmstdy"),
        label = "Select CMSTDY variable:",
        data_extract_spec = ui_args$cmstdy,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("cmendy"),
        label = "Select CMENDY variable:",
        data_extract_spec = ui_args$cmendy,
        is_single_dataset = is_single_dataset_value
      ),
      teal.widgets::panel_item(
        title = "Plot settings",
        collapsed = TRUE,
        teal.widgets::optionalSliderInputValMinMax(
          ns("font_size"),
          "Font Size",
          ui_args$font_size,
          ticks = FALSE,
          step = 1
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = ui_args$pre_output,
    post_output = ui_args$post_output
  )
}

#' @keywords internal
srv_g_therapy <- function(id,
                          data,
                          reporter,
                          filter_panel_api,
                          dataname,
                          parentname,
                          patient_col,
                          atirel,
                          cmdecod,
                          cmindc,
                          cmdose,
                          cmtrt,
                          cmdosu,
                          cmdosfrq,
                          cmroute,
                          cmstdy,
                          cmendy,
                          plot_height,
                          plot_width,
                          label,
                          ggplot2_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    patient_id <- reactive(input$patient_id)

    # Init
    patient_data_base <- reactive(unique(data()[[parentname]][[patient_col]]))
    teal.widgets::updateOptionalSelectInput(
      session, "patient_id",
      choices = patient_data_base(), selected = patient_data_base()[1]
    )

    observeEvent(patient_data_base(),
      handlerExpr = {
        teal.widgets::updateOptionalSelectInput(
          session,
          "patient_id",
          choices = patient_data_base(),
          selected = if (length(patient_data_base()) == 1) {
            patient_data_base()
          } else {
            intersect(patient_id(), patient_data_base())
          }
        )
      },
      ignoreInit = TRUE
    )

    # Therapy tab ----
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        atirel = atirel, cmdecod = cmdecod, cmindc = cmindc,
        cmdose = cmdose, cmtrt = cmtrt, cmdosu = cmdosu,
        cmroute = cmroute, cmdosfrq = cmdosfrq, cmstdy = cmstdy, cmendy = cmendy
      ),
      datasets = data,
      select_validation_rule = list(
        atirel = shinyvalidate::sv_required("Please select ATIREL variable."),
        cmdecod = shinyvalidate::sv_required("Please select medication decoding variable."),
        cmindc = shinyvalidate::sv_required("Please select CMINDC variable."),
        cmdose = shinyvalidate::sv_required("Please select CMDOSE variable."),
        cmtrt = shinyvalidate::sv_required("Please select CMTRT variable."),
        cmdosu = shinyvalidate::sv_required("Please select CMDOSU variable."),
        cmroute = shinyvalidate::sv_required("Please select CMROUTE variable."),
        cmdosfrq = shinyvalidate::sv_required("Please select CMDOSFRQ variable."),
        cmstdy = shinyvalidate::sv_required("Please select CMSTDY variable."),
        cmendy = shinyvalidate::sv_required("Please select CMENDY variable.")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient."))
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::left_join"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr))
    })

    merged <- list(anl_input_r = anl_inputs, anl_q = anl_q)

    all_q <- reactive({
      teal::validate_has_data(merged$anl_q()[["ANL"]], 1)

      teal::validate_inputs(iv_r())

      validate(
        need(
          nrow(merged$anl_q()[["ANL"]][input$patient_id == merged$anl_q()[["ANL"]][, patient_col], ]) > 0,
          "Selected patient is not in dataset (either due to filtering or missing values). Consider relaxing filters."
        )
      )

      my_calls <- template_therapy(
        dataname = "ANL",
        atirel = input[[extract_input("atirel", dataname)]],
        cmdecod = input[[extract_input("cmdecod", dataname)]],
        cmtrt = input[[extract_input("cmtrt", dataname)]],
        cmdosu = input[[extract_input("cmdosu", dataname)]],
        cmroute = input[[extract_input("cmroute", dataname)]],
        cmdosfrq = input[[extract_input("cmdosfrq", dataname)]],
        cmstdy = input[[extract_input("cmstdy", dataname)]],
        cmendy = input[[extract_input("cmendy", dataname)]],
        cmindc = input[[extract_input("cmindc", dataname)]],
        cmdose = input[[extract_input("cmdose", dataname)]],
        patient_id = patient_id(),
        font_size = input[["font_size"]],
        ggplot2_args = ggplot2_args
      )

      teal.code::eval_code(
        merged$anl_q(),
        substitute(
          expr = {
            pt_id <- patient_id
            ANL <- ANL[ANL[[patient_col]] == patient_id, ]
          }, env = list(
            patient_col = patient_col,
            patient_id = patient_id()
          )
        )
      ) %>%
        teal.code::eval_code(as.expression(my_calls))
    })

    output$title <- renderText({
      paste("<h5><b>Patient ID:", all_q()[["pt_id"]], "</b></h5>")
    })

    output$therapy_table <- DT::renderDataTable(
      expr = {
        teal.code::dev_suppress(all_q()[["therapy_table"]])
      },
      options = list(pageLength = input$therapy_table_rows)
    )

    plot_r <- reactive({
      req(iv_r()$is_valid())
      all_q()[["therapy_plot"]]
    })

    pws <- teal.widgets::plot_with_settings_srv(
      id = "therapy_plot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Patient Profile Therapy",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(teal.code::dev_suppress(all_q()[["therapy_table"]]))
        card$append_text("Plot", "header3")
        card$append_plot(plot_r(), dim = pws$dim())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' teal Module: Simple Bar Chart and Table of Counts per Category
#'
#' This module produces a [ggplot2::ggplot()] type bar chart and summary table of counts per category.
#'
#' Categories can be defined up to four levels deep and are defined through the `x`, `fill`,
#' `x_facet`, and `y_facet` parameters. Any parameters set to `NULL` (default) are ignored.
#'
#' @inheritParams module_arguments
#' @inheritParams template_arguments
#' @param x (`data_extract_spec`)\cr variable on the x-axis.
#' @param fill (`data_extract_spec`)\cr grouping variable to determine bar colors.
#' @param x_facet (`data_extract_spec`)\cr row-wise faceting groups.
#' @param y_facet (`data_extract_spec`)\cr column-wise faceting groups.
#' @param plot_options (`list`)\cr list of plot options.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' library(nestcolor)
#' library(dplyr)
#'
#' ADSL <- tmc_ex_adsl %>%
#'   mutate(ITTFL = factor("Y") %>%
#'     with_label("Intent-To-Treat Population Flag"))
#' ADAE <- tmc_ex_adae %>%
#'   filter(!((AETOXGR == 1) & (AESEV == "MILD") & (ARM == "A: Drug X")))
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADAE = ADAE,
#'     code = "ADSL <- tmc_ex_adsl %>%
#'               mutate(ITTFL = factor(\"Y\") %>%
#'               with_label(\"Intent-To-Treat Population Flag\"))
#'             ADAE <- tmc_ex_adae %>%
#'               filter(!((AETOXGR == 1) & (AESEV == \"MILD\") & (ARM == \"A: Drug X\")))"
#'   ),
#'   modules = modules(
#'     tm_g_barchart_simple(
#'       label = "ADAE Analysis",
#'       x = data_extract_spec(
#'         dataname = "ADSL",
#'         select = select_spec(
#'           choices = variable_choices(
#'             ADSL,
#'             c(
#'               "ARM", "ACTARM", "SEX",
#'               "RACE", "ITTFL", "SAFFL", "STRATA2"
#'             )
#'           ),
#'           selected = "ACTARM",
#'           multiple = FALSE
#'         )
#'       ),
#'       fill = list(
#'         data_extract_spec(
#'           dataname = "ADSL",
#'           select = select_spec(
#'             choices = variable_choices(
#'               ADSL,
#'               c(
#'                 "ARM", "ACTARM", "SEX",
#'                 "RACE", "ITTFL", "SAFFL", "STRATA2"
#'               )
#'             ),
#'             selected = "SEX",
#'             multiple = FALSE
#'           )
#'         ),
#'         data_extract_spec(
#'           dataname = "ADAE",
#'           select = select_spec(
#'             choices = variable_choices(ADAE, c("AETOXGR", "AESEV", "AESER")),
#'             selected = NULL,
#'             multiple = FALSE
#'           )
#'         )
#'       ),
#'       x_facet = list(
#'         data_extract_spec(
#'           dataname = "ADAE",
#'           select = select_spec(
#'             choices = variable_choices(ADAE, c("AETOXGR", "AESEV", "AESER")),
#'             selected = "AETOXGR",
#'             multiple = FALSE
#'           )
#'         ),
#'         data_extract_spec(
#'           dataname = "ADSL",
#'           select = select_spec(
#'             choices = variable_choices(
#'               ADSL,
#'               c(
#'                 "ARM", "ACTARM", "SEX",
#'                 "RACE", "ITTFL", "SAFFL", "STRATA2"
#'               )
#'             ),
#'             selected = NULL,
#'             multiple = FALSE
#'           )
#'         )
#'       ),
#'       y_facet = list(
#'         data_extract_spec(
#'           dataname = "ADAE",
#'           select = select_spec(
#'             choices = variable_choices(ADAE, c("AETOXGR", "AESEV", "AESER")),
#'             selected = "AESEV",
#'             multiple = FALSE
#'           )
#'         ),
#'         data_extract_spec(
#'           dataname = "ADSL",
#'           select = select_spec(
#'             choices = variable_choices(
#'               ADSL,
#'               c(
#'                 "ARM", "ACTARM", "SEX",
#'                 "RACE", "ITTFL", "SAFFL", "STRATA2"
#'               )
#'             ),
#'             selected = NULL,
#'             multiple = FALSE
#'           )
#'         )
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_g_barchart_simple <- function(x = NULL,
                                 fill = NULL,
                                 x_facet = NULL,
                                 y_facet = NULL,
                                 label = "Count Barchart",
                                 plot_options = NULL,
                                 plot_height = c(600L, 200L, 2000L),
                                 plot_width = NULL,
                                 pre_output = NULL,
                                 post_output = NULL,
                                 ggplot2_args = teal.widgets::ggplot2_args()) {
  message("Initializing tm_g_barchart_simple")
  checkmate::assert_string(label)
  checkmate::assert_list(plot_options, null.ok = TRUE)
  if (length(c(x, fill, x_facet, y_facet)) == 0) {
    stop("at least one must be specified. 'x', 'fill', 'x_facet', 'y_facet' is NULL")
  }
  x <- teal.transform::list_extract_spec(x, allow_null = TRUE)
  fill <- teal.transform::list_extract_spec(fill, allow_null = TRUE)
  x_facet <- teal.transform::list_extract_spec(x_facet, allow_null = TRUE)
  y_facet <- teal.transform::list_extract_spec(y_facet, allow_null = TRUE)
  teal.transform::check_no_multiple_selection(x)
  teal.transform::check_no_multiple_selection(fill)
  teal.transform::check_no_multiple_selection(x_facet)
  teal.transform::check_no_multiple_selection(y_facet)
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(ggplot2_args, "ggplot2_args")

  plot_options <- utils::modifyList(
    list(stacked = FALSE), # default
    `if`(is.null(plot_options), list(), plot_options)
  )

  ui_args <- as.list(environment())
  module(
    label = label,
    server = srv_g_barchart_simple,
    ui = ui_g_barchart_simple,
    ui_args = ui_args,
    server_args = list(
      x = x,
      fill = fill,
      x_facet = x_facet,
      y_facet = y_facet,
      plot_height = plot_height,
      plot_width = plot_width,
      ggplot2_args = ggplot2_args
    ),
    datanames = "all"
  )
}

#' @keywords internal
ui_g_barchart_simple <- function(id, ...) {
  ns <- NS(id)
  args <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(args$x, args$fill, args$x_facet, args$y_facet)

  tagList(
    singleton(
      tags$head(includeCSS(system.file("css/custom.css", package = "teal.modules.clinical")))
    ),
    teal.widgets::standard_layout(
      output = teal.widgets::white_small_well(
        teal.widgets::plot_with_settings_ui(id = ns("myplot")),
        uiOutput(ns("table"), class = "overflow-y-scroll max-h-250")
      ),
      encoding = tags$div(
        ### Reporter
        teal.reporter::simple_reporter_ui(ns("simple_reporter")),
        ###
        tags$label("Encodings", class = "text-primary"),
        teal.transform::datanames_input(args[c("x", "fill", "x_facet", "y_facet")]),
        if (!is.null(args$x)) {
          teal.transform::data_extract_ui(
            id = ns("x"),
            label = "X variable",
            data_extract_spec = args$x,
            is_single_dataset = is_single_dataset_value
          )
        },
        if (!is.null(args$fill)) {
          teal.transform::data_extract_ui(
            id = ns("fill"),
            label = "Fill",
            data_extract_spec = args$fill,
            is_single_dataset = is_single_dataset_value
          )
        },
        if (!is.null(args$x_facet)) {
          teal.transform::data_extract_ui(
            id = ns("x_facet"),
            label = "Column facetting variable",
            data_extract_spec = args$x_facet,
            is_single_dataset = is_single_dataset_value
          )
        },
        if (!is.null(args$y_facet)) {
          teal.transform::data_extract_ui(
            id = ns("y_facet"),
            label = "Row facetting variable",
            data_extract_spec = args$y_facet,
            is_single_dataset = is_single_dataset_value
          )
        },
        teal.widgets::panel_group(
          teal.widgets::panel_item(
            "Additional plot settings",
            if (!is.null(args$fill)) {
              radioButtons(
                inputId = ns("barlayout"),
                label = "Covariate Bar Layout",
                choices = c("Side by side" = "side_by_side", "Stacked" = "stacked"),
                selected = if (args$plot_options$stacked) "stacked" else "side_by_side",
                inline = TRUE
              )
            },
            if (!(is.null(args$x_facet))) {
              checkboxInput(
                ns("facet_scale_x"),
                "Fixed scales for column facets",
                value = TRUE
              )
            },
            if (!(is.null(args$y_facet))) {
              checkboxInput(
                ns("facet_scale_y"),
                "Fixed scales for row facets",
                value = TRUE
              )
            },
            checkboxInput(
              ns("label_bars"),
              "Label bars",
              value = `if`(is.null(args$plot_options$label_bars), TRUE, args$plot_options$label_bars)
            ),
            checkboxInput(
              ns("rotate_bar_labels"),
              "Rotate bar labels",
              value = `if`(is.null(args$plot_options$rotate_bar_labels), FALSE, args$plot_options$rotate_bar_labels)
            ),
            checkboxInput(
              ns("rotate_x_label"),
              "Rotate x label",
              value = `if`(is.null(args$plot_options$rotate_x_label), FALSE, args$plot_options$rotate_x_label)
            ),
            checkboxInput(
              ns("rotate_y_label"),
              "Rotate y label",
              value = `if`(is.null(args$plot_options$rotate_y_label), FALSE, args$plot_options$rotate_y_label)
            ),
            checkboxInput(
              ns("flip_axis"),
              "Flip axes",
              value = `if`(is.null(args$plot_options$flip_axis), FALSE, args$plot_options$flip_axis)
            ),
            checkboxInput(
              ns("show_n"),
              "Show n",
              value = `if`(is.null(args$plot_options$show_n), TRUE, args$plot_options$show_n)
            ),
            sliderInput(
              inputId = ns("expand_y_range"),
              label = "Y-axis range expansion (fraction on top)",
              min = 0,
              max = 1,
              value = 0.5,
              step = 0.1
            )
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = args$pre_output,
    post_output = args$post_output
  )
}

#' @keywords internal
srv_g_barchart_simple <- function(id,
                                  data,
                                  reporter,
                                  filter_panel_api,
                                  x,
                                  fill,
                                  x_facet,
                                  y_facet,
                                  plot_height,
                                  plot_width,
                                  ggplot2_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    rule_dupl <- function(others) {
      function(value) {
        othervals <- lapply(
          Filter(Negate(is.null), selector_list()[others]), # some selectors could be ommited in tm_g_barchart_simple
          function(x) x()$select
        )
        vars <- c(value, unlist(othervals))
        dups <- unique(vars[duplicated(vars)])
        if (value %in% dups) {
          paste("Duplicated value:", value, collapse = ", ")
        }
      }
    }

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(x = x, fill = fill, x_facet = x_facet, y_facet = y_facet),
      datasets = data,
      select_validation_rule = list(
        x = shinyvalidate::compose_rules(
          shinyvalidate::sv_required("Please select an x-variable"),
          rule_dupl(others = c("fill", "x_facet", "y_facet"))
        ),
        fill = shinyvalidate::compose_rules(
          shinyvalidate::sv_optional(),
          rule_dupl(others = c("x", "x_facet", "y_facet"))
        ),
        x_facet = shinyvalidate::compose_rules(
          shinyvalidate::sv_optional(),
          rule_dupl(others = c("fill", "x", "y_facet"))
        ),
        y_facet = shinyvalidate::compose_rules(
          shinyvalidate::sv_optional(),
          rule_dupl(others = c("fill", "x_facet", "x"))
        )
      ),
      dataset_validation_rule = list(
        fill = NULL,
        x_facet = NULL,
        y_facet = NULL
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr))
    })

    count_q <- reactive({
      anl_q <- anl_q()
      teal::validate_has_data(anl_q[["ANL"]], 2)
      groupby_vars <- r_groupby_vars()

      # count
      count_by_group <- function(groupby_vars, data_name) {
        n_name <- get_n_name(groupby_vars)
        count_by_group_expr(groupby_vars = groupby_vars, data_name = data_name)
      }

      count_exprs <- count_by_group(groupby_vars, data_name = "ANL")

      if (input$show_n) {
        count_exprs2 <- sapply(groupby_vars[-1], count_by_group, data_name = "counts")
        count_str_to_col_exprs <- sapply(groupby_vars[-1], count_str_to_column_expr)
        count_exprs <- c(count_exprs, count_exprs2, count_str_to_col_exprs)
      }

      data_list <- sapply(teal.data::datanames(data()), function(x) reactive(data()[[x]]),
        simplify = FALSE
      )

      anl_q <- anl_q %>%
        teal.code::eval_code(code = count_exprs)

      # add label and slice(1) as all patients in the same subgroup have same n_'s
      anl_q <- anl_q %>%
        teal.code::eval_code(
          as.expression(
            c(
              bquote(attr(counts[[.(get_n_name(groupby_vars))]], "label") <- "Count"),
              bquote(
                counts <- counts %>%
                  dplyr::group_by_at(.(as.vector(groupby_vars))) %>%
                  dplyr::slice(1) %>%
                  dplyr::ungroup() %>%
                  dplyr::select(.(as.vector(groupby_vars)), dplyr::starts_with("n_"))
              )
            )
          )
        )

      # dplyr::select loses labels
      anl_q %>%
        teal.code::eval_code(
          teal.transform::get_anl_relabel_call(
            columns_source = anl_inputs()$columns_source,
            datasets = data_list,
            anl_name = "counts"
          )
        )
    })

    all_q <- reactive({
      teal::validate_inputs(iv_r())
      groupby_vars <- as.list(r_groupby_vars()) # so $ access works below

      y_lab <- substitute(
        column_annotation_label(counts, y_name),
        list(y_name = get_n_name(groupby_vars))
      )

      all_ggplot2_args <- teal.widgets::resolve_ggplot2_args(
        user_plot = ggplot2_args,
        module_plot = teal.widgets::ggplot2_args(
          labs = list(
            title = quote(plot_title),
            y = y_lab
          ),
          theme = list(plot.title = quote(ggplot2::element_text(hjust = 0.5)))
        )
      )

      plot_call <- make_barchart_simple_call(
        y_name = get_n_name(groupby_vars),
        x_name = groupby_vars$x_name,
        fill_name = groupby_vars$fill_name,
        x_facet_name = groupby_vars$x_facet_name,
        y_facet_name = groupby_vars$y_facet_name,
        label_bars = input$label_bars,
        barlayout = input$barlayout,
        flip_axis = input$flip_axis,
        rotate_bar_labels = input$rotate_bar_labels,
        rotate_x_label = input$rotate_x_label,
        rotate_y_label = input$rotate_y_label,
        expand_y_range = input$expand_y_range,
        facet_scales = get_facet_scale(input$facet_scale_x, input$facet_scale_y),
        ggplot2_args = all_ggplot2_args
      )

      ANL <- count_q()[["ANL"]]

      all_q <- count_q() %>%
        teal.code::eval_code(substitute(
          env = list(groupby_vars = paste(groupby_vars, collapse = ", ")),
          plot_title <- sprintf(
            "Number of patients (total N = %s) for each combination of (%s)",
            nrow(ANL),
            groupby_vars
          )
        )) %>%
        teal.code::eval_code(code = plot_call)

      # explicitly calling print on the plot inside the qenv evaluates
      # the ggplot call and therefore catches errors
      teal.code::eval_code(all_q, code = quote(print(plot)))
    })

    plot_r <- reactive(all_q()[["plot"]])

    output$table <- renderTable({
      req(iv_r()$is_valid())
      teal.code::dev_suppress(all_q()[["counts"]])
    })

    # get grouping variables
    # NULL: not present in UI, vs character(0): no selection
    ## returns named vector of non-NULL variables to group by
    r_groupby_vars <- function() {
      x_name <- if (is.null(x)) NULL else as.vector(anl_inputs()$columns_source$x)
      fill_name <- if (is.null(fill)) NULL else as.vector(anl_inputs()$columns_source$fill)
      x_facet_name <- if (is.null(x_facet)) NULL else as.vector(anl_inputs()$columns_source$x_facet)
      y_facet_name <- if (is.null(y_facet)) NULL else as.vector(anl_inputs()$columns_source$y_facet)

      # set to NULL when empty character
      if (identical(x_name, character(0))) x_name <- NULL
      if (identical(fill_name, character(0))) fill_name <- NULL
      if (identical(x_facet_name, character(0))) x_facet_name <- NULL
      if (identical(y_facet_name, character(0))) y_facet_name <- NULL

      c(
        x_name = x_name, fill_name = fill_name,
        x_facet_name = x_facet_name, y_facet_name = y_facet_name
      ) # c() -> NULL entries are omitted
    }

    # Insert the plot into a plot with settings module from teal.widgets
    pws <- teal.widgets::plot_with_settings_srv(
      id = "myplot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = "Bar Chart"
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Barchart Plot",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Plot", "header3")
        card$append_plot(plot_r(), dim = pws$dim())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

# Helper functions for qenv ----

#' `ggplot2` call to generate simple bar chart
#'
#' @inheritParams tm_g_barchart_simple
#' @param y_name (`character` or `NULL`)\cr name of the y-axis variable.
#' @param x_name (`character` or `NULL`)\cr name of the x-axis variable. Defaults to `NULL` because it is dependent
#'   on extract input which can be empty.
#' @param fill_name (`character` or `NULL`)\cr name of the variable to determine the bar fill color.
#' @param x_facet_name (`character` or `NULL`)\cr name of the variable to use for horizontal plot faceting.
#' @param y_facet_name (`character` or `NULL`)\cr name of the variable to use for vertical plot faceting.
#' @param label_bars (`logical` or `NULL`)\cr whether bars should be labeled. If `TRUE`, label bar numbers would
#'   also be drawn as text.
#' @param barlayout (`character` or `NULL`)\cr type of the bar layout. Options are `"stacked"` (default) or
#'   `"side_by_side"`.
#' @param flip_axis (`character` or `NULL`)\cr whether to flip the plot axis.
#' @param rotate_bar_labels (`logical` or `NULL`)\cr whether bar labels should be rotated by 45 degrees.
#' @param rotate_x_label (`logical` or `NULL`)\cr whether x-axis labels should be rotated by 45 degrees.
#' @param rotate_y_label (`logical` or `NULL`)\cr whether y-axis labels should be rotated by 45 degrees.
#' @param expand_y_range (`numeric` or `NULL`)\cr fraction of y-axis range to further expand by.
#' @param facet_scales (`character`)\cr value passed to `scales` argument of [ggplot2::facet_grid()]. Options are
#'   `fixed`, `free_x`, `free_y`, and `free`.
#'
#' @return `call` to produce a `ggplot` object.
#'
#' @keywords internal
make_barchart_simple_call <- function(y_name,
                                      x_name = NULL,
                                      fill_name = NULL,
                                      x_facet_name = NULL,
                                      y_facet_name = NULL,
                                      label_bars = TRUE,
                                      barlayout = c("side_by_side", "stacked"),
                                      flip_axis = FALSE,
                                      rotate_bar_labels = FALSE,
                                      rotate_x_label = FALSE,
                                      rotate_y_label = FALSE,
                                      expand_y_range = 0,
                                      facet_scales = "free_x",
                                      ggplot2_args = teal.widgets::ggplot2_args()) {
  checkmate::assert_string(y_name)
  checkmate::assert_string(x_name, null.ok = TRUE)
  checkmate::assert_string(fill_name, null.ok = TRUE)
  checkmate::assert_string(x_facet_name, null.ok = TRUE)
  checkmate::assert_string(y_facet_name, null.ok = TRUE)
  checkmate::assert_character(c(x_name, fill_name, x_facet_name, y_facet_name))
  checkmate::assert_flag(label_bars)
  checkmate::assert_scalar(expand_y_range)
  barlayout <- match.arg(barlayout)
  checkmate::assert_flag(flip_axis, null.ok = TRUE)
  checkmate::assert_flag(rotate_x_label, null.ok = TRUE)
  checkmate::assert_flag(rotate_y_label, null.ok = TRUE)

  plot_args <- list(quote(ggplot2::ggplot(counts)))

  # aesthetic variables
  x_val_var <- if (is.null(x_name)) 0 else x_name
  plot_args <- c(
    plot_args,
    if (is.null(fill_name)) {
      bquote(ggplot2::aes(x = .data[[.(x_val_var)]]))
    } else {
      bquote(ggplot2::aes(x = .data[[.(x_val_var)]], fill = .data[[.(fill_name)]]))
    }
  )

  if (!(is.null(x_facet_name) && is.null(y_facet_name))) {
    # free_x is needed, otherwise when we facet on x and x-ticks are different for each facet value,
    # it will fit all possible x-ticks across all facet values into each facet panel
    plot_args <- c(plot_args, bquote(
      ggplot2::facet_grid(.(facet_grid_formula(x_facet_name, y_facet_name)), scales = .(facet_scales))
    ))
  }

  # position stacking or dodging for bars and text
  position <- if (is.null(fill_name) || (barlayout == "side_by_side")) {
    # vjust = on top, i.e. don't place below when only one filling (i.e. nothing really stacked)
    quote(ggplot2::position_dodge(0.9))
  } else {
    quote(ggplot2::position_stack(vjust = 0.5))
  }

  # draw bars
  if (is.null(fill_name)) {
    # nothing to put side-by-side, so put fill to one color only
    # setting color via aesthetics does not work for some reason (but x = 0 above works)
    plot_args <- c(plot_args, bquote(
      ggplot2::geom_col(
        ggplot2::aes(
          y = .data[[.(y_name)]]
        ),
        position = .(position),
        fill = .(ifelse(
          !is.null(getOption("ggplot2.discrete.colour")),
          getOption("ggplot2.discrete.colour")[1],
          "#b6cae9"
        ))
      )
    ))
  } else {
    plot_args <- c(plot_args, bquote(
      ggplot2::geom_col(ggplot2::aes(y = .data[[.(y_name)]]), position = .(position))
    ))
  }

  # draw numbers above bars
  if (label_bars) {
    # center text and move slightly to the top or to the right (depending on flip axes)
    # see https://stackoverflow.com/questions/7263849/what-do-hjust-and-vjust-do-when-making-a-plot-using-ggplot
    if (isTRUE(flip_axis)) {
      hjust <- if (barlayout == "stacked") 0.5 else -1 # put above bars if not stacked
      vjust <- 0.5
    } else {
      hjust <- 0.5
      vjust <- if (barlayout == "stacked") 0.5 else -1 # put above bars if not stacked
    }

    plot_args <- c(plot_args, bquote(
      ggplot2::geom_text(ggplot2::aes(y = .data[[.(y_name)]], label = .data[[.(y_name)]]),
        stat = "identity",
        angle = .(if (rotate_bar_labels) 45 else 0),
        position = .(position),
        # hjust, vjust are respective to position, i.e. top, center etc. alignment
        hjust = .(hjust), vjust = .(vjust)
      )
    ))
  }

  # add legend for fill
  if (!is.null(fill_name)) {
    plot_args <- c(plot_args, bquote(
      ggplot2::guides(fill = ggplot2::guide_legend(title = column_annotation_label(counts, .(fill_name))))
    ))
  }

  if (isTRUE(flip_axis)) plot_args <- c(plot_args, quote(ggplot2::coord_flip()))

  if (expand_y_range > 0) {
    plot_args <- c(plot_args, bquote(ggplot2::scale_y_continuous(
      labels = scales::comma,
      expand = ggplot2::expansion(c(0, .(expand_y_range)))
    )))
  }

  if (isTRUE(rotate_x_label)) ggplot2_args$theme[["axis.text.x"]] <- quote(ggplot2::element_text(angle = 45, hjust = 1))
  if (isTRUE(rotate_y_label)) ggplot2_args$theme[["axis.text.y"]] <- quote(ggplot2::element_text(angle = 45, hjust = 1))
  if (!is.null(x_name)) {
    ggplot2_args$labs[["x"]] <- substitute(
      expr = column_annotation_label(counts, x_name),
      env = list(x_name = x_name)
    )
  } else {
    ggplot2_args$theme[["axis.text.x"]] <- quote(ggplot2::element_blank())
    ggplot2_args$theme[["axis.ticks.x"]] <- quote(ggplot2::element_blank())
  }

  parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args(ggplot2_args)
  plot_args <- c(plot_args, parsed_ggplot2_args)

  bquote(plot <- .(call_concatenate(plot_args)))
}

# get name of column in "counts" data.frame
get_n_name <- function(groupby_vars) {
  paste0("n_", paste(groupby_vars, collapse = "_"))
}

# expression that counts by specified group
# n_name: name of column to add counts to, by default determined from groupby_vars
count_by_group_expr <- function(groupby_vars, data_name = "counts") {
  checkmate::assert_character(groupby_vars)
  n_name <- get_n_name(groupby_vars)

  parse(
    text = sprintf(
      "counts <- %s %%>%% dplyr::group_by(%s) %%>%% dplyr::mutate(%s = dplyr::n()) %%>%% dplyr::ungroup()",
      data_name,
      paste(groupby_vars, collapse = ","),
      n_name
    ),
    keep.source = FALSE
  )
}

get_facet_scale <- function(x, y) {
  facet_scale_x <- if (isTRUE(x)) {
    "fixed"
  } else {
    "free"
  }
  facet_scale_y <- if (isTRUE(y)) {
    "fixed"
  } else {
    "free"
  }

  if (facet_scale_x == "fixed" && facet_scale_y == "free") {
    "free_y"
  } else if (facet_scale_x == "free" && facet_scale_y == "fixed") {
    "free_x"
  } else {
    facet_scale_x # fixed or free, as x and y match
  }
}

#' Template: Response Forest Plot
#'
#' Creates a valid expression to generate a response forest plot.
#'
#' @inheritParams tern::g_forest
#' @inheritParams template_arguments
#' @param stats (`character`)\cr the names of statistics to be reported among:
#'   * `n`: Total number of observations per group.
#'   * `n_rsp`: Number of responders per group.
#'   * `prop`: Proportion of responders.
#'   * `n_tot`: Total number of observations.
#'   * `or`: Odds ratio.
#'   * `ci` : Confidence interval of odds ratio.
#'   * `pval`: p-value of the effect.
#'   Note, the statistics `n_tot`, `or`, and `ci` are required.
#' @param riskdiff (`list`)\cr if a risk (proportion) difference column should be added, a list of settings to apply
#'   within the column. See [control_riskdiff()] for details. If `NULL`, no risk difference column will be added.
#' @param obj_var_name (`character`)\cr additional text to append to the table title.
#' @param responders (`character`)\cr values of `aval_var` that are considered to be responders.
#' @param col_symbol_size (`integer` or `NULL`)\cr column index to be used to determine relative size for
#'  estimator plot symbol. Typically, the symbol size is proportional to the sample size used
#'  to calculate the estimator. If `NULL`, the same symbol size is used for all subgroups.
#' @param strata_var (`character`)\cr names of the variables for stratified analysis.
#' @param ggplot2_args (`ggplot2_args`) optional\cr
#'   object created by [teal.widgets::ggplot2_args()] with settings for the module plot. For this
#'   module, this argument will only accept `ggplot2_args` object with `labs` list of following child
#'   elements: `title`, `caption`. No other elements would be taken into account. The argument is
#'   merged with option `teal.ggplot2_args` and with default module arguments (hard coded in the module body).
#'
#'   For more details, see the vignette: `vignette("custom-ggplot2-arguments", package = "teal.widgets")`.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_g_forest_rsp()]
#'
#' @keywords internal
template_forest_rsp <- function(dataname = "ANL",
                                parentname = "ADSL",
                                arm_var,
                                ref_arm = NULL,
                                comp_arm = NULL,
                                obj_var_name = "",
                                aval_var = "AVALC",
                                responders = c("CR", "PR"),
                                subgroup_var,
                                strata_var = NULL,
                                stats = c("n_tot", "n", "n_rsp", "prop", "or", "ci"),
                                riskdiff = NULL,
                                conf_level = 0.95,
                                col_symbol_size = NULL,
                                rel_width_forest = 0.25,
                                font_size = 15,
                                ggplot2_args = teal.widgets::ggplot2_args()) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(arm_var)
  checkmate::assert_string(aval_var)
  checkmate::assert_string(obj_var_name)
  checkmate::assert_character(subgroup_var, null.ok = TRUE)
  checkmate::assert_character(stats, min.len = 3)
  checkmate::assert_true(all(c("n_tot", "or", "ci") %in% stats))
  checkmate::assert_list(riskdiff, null.ok = TRUE)
  checkmate::assert_number(rel_width_forest, lower = 0, upper = 1)
  checkmate::assert_number(font_size)

  y <- list()
  ref_arm_val <- paste(ref_arm, collapse = "/")

  # Data processing.
  data_list <- list()
  anl_list <- list()
  parent_list <- list()

  anl_list <- add_expr(
    anl_list,
    prepare_arm(
      dataname = dataname,
      arm_var = arm_var,
      ref_arm = ref_arm,
      comp_arm = comp_arm,
      ref_arm_val = ref_arm_val
    )
  )

  anl_list <- add_expr(
    anl_list,
    substitute(
      expr = dplyr::mutate(is_rsp = aval_var %in% responders),
      env = list(
        aval_var = as.name(aval_var),
        responders = responders
      )
    )
  )

  anl_list <- add_expr(
    anl_list,
    substitute_names(
      expr = dplyr::mutate(arm_var = combine_levels(arm_var, levels = comp_arm)),
      names = list(arm_var = as.name(arm_var)),
      others = list(comp_arm = comp_arm)
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      anl <- anl_list,
      env = list(
        anl = as.name(dataname),
        anl_list = pipe_expr(anl_list)
      )
    )
  )

  parent_list <- add_expr(
    parent_list,
    prepare_arm(
      dataname = parentname,
      arm_var = arm_var,
      ref_arm = ref_arm,
      comp_arm = comp_arm,
      ref_arm_val = ref_arm_val
    )
  )

  parent_list <- add_expr(
    parent_list,
    substitute_names(
      expr = dplyr::mutate(arm_var = combine_levels(arm_var, levels = comp_arm)),
      names = list(arm_var = as.name(arm_var)),
      others = list(comp_arm = comp_arm)
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      parent <- parent_list,
      env = list(
        parent_list = pipe_expr(parent_list)
      )
    )
  )

  y$data <- bracket_expr(data_list)

  # Tabulate subgroup analysis of response.
  summary_list <- list()

  summary_list <- add_expr(
    summary_list,
    substitute(
      expr = df <- extract_rsp_subgroups(
        variables = list(
          rsp = "is_rsp", arm = arm_var, subgroups = subgroup_var, strata = strata_var
        ),
        data = anl,
        conf_level = conf_level
      ),
      env = list(
        anl = as.name(dataname),
        arm_var = arm_var,
        subgroup_var = subgroup_var,
        strata_var = strata_var,
        conf_level = conf_level
      )
    )
  )

  y$summary <- bracket_expr(summary_list)

  # Table output.
  y$table <- substitute(
    expr = result <- rtables::basic_table() %>%
      tabulate_rsp_subgroups(df, vars = stats, riskdiff = riskdiff),
    env = list(stats = stats, riskdiff = riskdiff)
  )

  all_ggplot2_args <- teal.widgets::resolve_ggplot2_args(
    user_plot = ggplot2_args,
    module_plot = teal.widgets::ggplot2_args(
      labs = list(
        title = paste("Forest Plot of Best Overall Response for", obj_var_name),
        caption = ""
      )
    )
  )

  plot_list <- list()

  plot_list <- add_expr(
    plot_list,
    substitute(
      expr = {
        f <- g_forest(
          tbl = result,
          col_symbol_size = col_s_size,
          font_size = font_size,
          as_list = TRUE
        )
      },
      env = list(
        col_s_size = col_symbol_size,
        font_size = font_size
      )
    )
  )

  plot_list <- add_expr(
    plot_list,
    substitute(
      expr = {
        p <- cowplot::plot_grid(
          f[["table"]] + ggplot2::labs(title = ggplot2_args_title),
          f[["plot"]] + ggplot2::labs(caption = ggplot2_args_caption),
          align = "h",
          axis = "tblr",
          rel_widths = c(1 - rel_width_forest, rel_width_forest)
        )
      },
      env = list(
        rel_width_forest = rel_width_forest,
        ggplot2_args_title = all_ggplot2_args$labs$title,
        ggplot2_args_caption = all_ggplot2_args$labs$caption
      )
    )
  )

  # Plot output.
  y$plot <- plot_list

  y
}

#' teal Module: Forest Response Plot
#'
#' This module produces a grid-style forest plot for response data with ADaM structure.
#'
#' @inheritParams tern::g_forest
#' @inheritParams module_arguments
#' @inheritParams template_forest_rsp
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' library(nestcolor)
#' library(dplyr)
#'
#' ADSL <- tmc_ex_adsl
#' ADRS <- tmc_ex_adrs %>%
#'   mutate(AVALC = d_onco_rsp_label(AVALC) %>%
#'     with_label("Character Result/Finding")) %>%
#'   filter(PARAMCD != "OVRINV" | AVISIT == "FOLLOW UP")
#'
#' arm_ref_comp <- list(
#'   ARM = list(
#'     ref = "B: Placebo",
#'     comp = c("A: Drug X", "C: Combination")
#'   ),
#'   ARMCD = list(
#'     ref = "ARM B",
#'     comp = c("ARM A", "ARM C")
#'   )
#' )
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADRS = ADRS,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADRS <- tmc_ex_adrs %>%
#'         mutate(AVALC = d_onco_rsp_label(AVALC) %>%
#'         with_label(\"Character Result/Finding\")) %>%
#'         filter(PARAMCD != \"OVRINV\" | AVISIT == \"FOLLOW UP\")
#'     "
#'   ),
#'   modules = modules(
#'     tm_g_forest_rsp(
#'       label = "Forest Response",
#'       dataname = "ADRS",
#'       arm_var = choices_selected(
#'         variable_choices(ADSL, c("ARM", "ARMCD")),
#'         "ARMCD"
#'       ),
#'       arm_ref_comp = arm_ref_comp,
#'       paramcd = choices_selected(
#'         value_choices(ADRS, "PARAMCD", "PARAM"),
#'         "INVET"
#'       ),
#'       subgroup_var = choices_selected(
#'         variable_choices(ADSL, names(ADSL)),
#'         c("BMRKR2", "SEX")
#'       ),
#'       strata_var = choices_selected(
#'         variable_choices(ADSL, c("STRATA1", "STRATA2")),
#'         "STRATA2"
#'       ),
#'       plot_height = c(600L, 200L, 2000L),
#'       default_responses = list(
#'         BESRSPI = list(
#'           rsp = c("Stable Disease (SD)", "Not Evaluable (NE)"),
#'           levels = c(
#'             "Complete Response (CR)", "Partial Response (PR)", "Stable Disease (SD)",
#'             "Progressive Disease (PD)", "Not Evaluable (NE)"
#'           )
#'         ),
#'         INVET = list(
#'           rsp = c("Complete Response (CR)", "Partial Response (PR)"),
#'           levels = c(
#'             "Complete Response (CR)", "Not Evaluable (NE)", "Partial Response (PR)",
#'             "Progressive Disease (PD)", "Stable Disease (SD)"
#'           )
#'         ),
#'         OVRINV = list(
#'           rsp = c("Progressive Disease (PD)", "Stable Disease (SD)"),
#'           levels = c("Progressive Disease (PD)", "Stable Disease (SD)", "Not Evaluable (NE)")
#'         )
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_g_forest_rsp <- function(label,
                            dataname,
                            parentname = ifelse(
                              inherits(arm_var, "data_extract_spec"),
                              teal.transform::datanames_input(arm_var),
                              "ADSL"
                            ),
                            arm_var,
                            arm_ref_comp = NULL,
                            paramcd,
                            aval_var = teal.transform::choices_selected(
                              teal.transform::variable_choices(dataname, "AVALC"), "AVALC",
                              fixed = TRUE
                            ),
                            subgroup_var,
                            strata_var,
                            stats = c("n_tot", "n", "n_rsp", "prop", "or", "ci"),
                            riskdiff = NULL,
                            fixed_symbol_size = TRUE,
                            conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE),
                            default_responses = c("CR", "PR", "Y", "Complete Response (CR)", "Partial Response (PR)"),
                            plot_height = c(500L, 200L, 2000L),
                            plot_width = c(1500L, 800L, 3000L),
                            rel_width_forest = c(25L, 0L, 100L),
                            font_size = c(15L, 1L, 30L),
                            pre_output = NULL,
                            post_output = NULL,
                            ggplot2_args = teal.widgets::ggplot2_args()) {
  message("Initializing tm_g_forest_rsp")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_flag(fixed_symbol_size)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(aval_var, "choices_selected")
  checkmate::assert_class(subgroup_var, "choices_selected")
  checkmate::assert_class(strata_var, "choices_selected")
  checkmate::assert_class(conf_level, "choices_selected")
  checkmate::assert_character(stats, min.len = 3)
  checkmate::assert_true(all(c("n_tot", "or", "ci") %in% stats))
  checkmate::assert_list(riskdiff, null.ok = TRUE)
  checkmate::assert_multi_class(default_responses, c("list", "character", "numeric"), null.ok = TRUE)
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(ggplot2_args, "ggplot2_args")

  args <- as.list(environment())

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname),
    aval_var = cs_to_des_select(aval_var, dataname = dataname),
    subgroup_var = cs_to_des_select(subgroup_var, dataname = parentname, multiple = TRUE, ordered = TRUE),
    strata_var = cs_to_des_select(strata_var, dataname = parentname, multiple = TRUE)
  )

  module(
    label = label,
    ui = ui_g_forest_rsp,
    ui_args = c(data_extract_list, args),
    server = srv_g_forest_rsp,
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        arm_ref_comp = arm_ref_comp,
        label = label,
        stats = stats,
        riskdiff = riskdiff,
        default_responses = default_responses,
        plot_height = plot_height,
        plot_width = plot_width,
        ggplot2_args = ggplot2_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_g_forest_rsp <- function(id, ...) {
  a <- list(...) # module args
  is_single_dataset_value <- teal.transform::is_single_dataset(a$arm_var, a$paramcd, a$subgroup_var, a$strata_var)

  ns <- NS(id)

  teal.widgets::standard_layout(
    output = teal.widgets::plot_with_settings_ui(id = ns("myplot")),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c("arm_var", "paramcd", "aval_var", "subgroup_var", "strata_var")]),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select Endpoint",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("aval_var"),
        label = "Analysis Variable",
        data_extract_spec = a$aval_var,
        is_single_dataset = is_single_dataset_value
      ),
      selectInput(
        ns("responders"),
        "Responders",
        choices = c("CR", "PR"),
        selected = c("CR", "PR"),
        multiple = TRUE
      ),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      uiOutput(
        ns("arms_buckets"),
        title = paste(
          "Multiple reference groups are automatically combined into a single group when more than one",
          "value is selected."
        )
      ),
      teal.transform::data_extract_ui(
        id = ns("subgroup_var"),
        label = "Subgroup Variables",
        data_extract_spec = a$subgroup_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("strata_var"),
        label = "Stratify by",
        data_extract_spec = a$strata_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional plot settings",
          teal.widgets::optionalSelectInput(
            inputId = ns("conf_level"),
            label = "Confidence Level",
            a$conf_level$choices,
            a$conf_level$selected,
            multiple = FALSE,
            fixed = a$conf_level$fixed
          ),
          checkboxInput(ns("fixed_symbol_size"), "Fixed symbol size", value = TRUE),
          teal.widgets::optionalSliderInputValMinMax(
            ns("rel_width_forest"),
            "Relative Width of Forest Plot (%)",
            a$rel_width_forest,
            ticks = FALSE, step = 1
          ),
          teal.widgets::optionalSliderInputValMinMax(
            ns("font_size"),
            "Table Font Size",
            a$font_size,
            ticks = FALSE, step = 1
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_g_forest_rsp <- function(id,
                             data,
                             reporter,
                             filter_panel_api,
                             dataname,
                             parentname,
                             arm_var,
                             arm_ref_comp,
                             paramcd,
                             aval_var,
                             subgroup_var,
                             strata_var,
                             stats,
                             riskdiff,
                             plot_height,
                             plot_width,
                             label,
                             default_responses,
                             ggplot2_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    # Setup arm variable selection, default reference arms, and default
    # comparison arms for encoding panel
    iv_arm_ref <- arm_ref_comp_observer(
      session,
      input,
      output,
      id_arm_var = extract_input("arm_var", parentname),
      data = data()[[parentname]],
      arm_ref_comp = arm_ref_comp,
      module = "tm_t_tte"
    )

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        arm_var = arm_var,
        subgroup_var = subgroup_var,
        strata_var = strata_var,
        paramcd = paramcd,
        aval_var = aval_var
      ),
      datasets = data,
      select_validation_rule = list(
        aval_var = shinyvalidate::sv_required("An analysis variable is required"),
        arm_var = shinyvalidate::sv_required("A treatment variable is required")
      ),
      filter_validation_rule = list(paramcd = shinyvalidate::sv_required(message = "Please select Endpoint filter."))
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1"))
      iv$add_rule(
        "conf_level",
        shinyvalidate::sv_between(0, 1, message_fmt = "Please choose a confidence level between {left} and {right}")
      )
      iv$add_rule("responders", shinyvalidate::sv_required("`Responders` field is empty"))
      iv$add_validator(iv_arm_ref)
      teal.transform::compose_and_enable_validators(iv, selector_list, c("arm_var", "aval_var", "paramcd"))
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var, subgroup_var = subgroup_var, strata_var = strata_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(code = as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(code = as.expression(adsl_inputs()$expr))
    })

    observeEvent(
      eventExpr = c(
        input[[extract_input("aval_var", "ADRS")]],
        input[[extract_input("paramcd", paramcd$filter[[1]]$dataname, filter = TRUE)]]
      ),
      handlerExpr = {
        req(anl_q())
        anl <- anl_q()[["ANL"]]
        aval_var <- anl_inputs()$columns_source$aval_var
        paramcd_level <- unlist(anl_inputs()$filter_info$paramcd[[1]]$selected)
        if (length(paramcd_level) == 0) {
          return(NULL)
        }

        sel_param <- if (is.list(default_responses)) {
          default_responses[[paramcd_level]]
        } else {
          default_responses
        }


        common_rsp <- if (is.list(sel_param)) {
          sel_param$rsp
        } else {
          sel_param
        }
        responder_choices <- if (length(aval_var) == 0) {
          character(0)
        } else {
          if ("levels" %in% names(sel_param)) {
            if (length(intersect(unique(anl[[aval_var]]), sel_param$levels)) > 1) {
              sel_param$levels
            } else {
              union(anl[[aval_var]], sel_param$levels)
            }
          } else {
            unique(anl[[aval_var]])
          }
        }
        updateSelectInput(
          session, "responders",
          choices = responder_choices,
          selected = intersect(responder_choices, common_rsp)
        )
      }
    )

    # Prepare the analysis environment (filter data, check data, populate envir).
    validate_checks <- reactive({
      teal::validate_inputs(iv_r())
      req(anl_q())
      adsl_filtered <- anl_q()[[parentname]]
      anl_filtered <- anl_q()[[dataname]]
      anl <- anl_q()[["ANL"]]

      anl_m <- anl_inputs()
      input_arm_var <- as.vector(anl_m$columns_source$arm_var)
      input_aval_var <- as.vector(anl_m$columns_source$aval_var)
      input_subgroup_var <- as.vector(anl_m$columns_source$subgroup_var)
      input_strata_var <- as.vector(anl_m$columns_source$strata_var)
      input_paramcd <- unlist(paramcd$filter)["vars_selected"]

      # validate inputs
      validate_args <- list(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var, input_subgroup_var, input_strata_var),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_paramcd, input_aval_var),
        arm_var = input_arm_var
      )
      validate_args <- append(
        validate_args,
        list(ref_arm = unlist(input$buckets$Ref), comp_arm = unlist(input$buckets$Comp))
      )

      do.call(what = "validate_standard_inputs", validate_args)

      teal::validate_one_row_per_id(anl_q()[["ANL"]], key = c("USUBJID", "STUDYID", input_paramcd))

      if (length(input_subgroup_var) > 0) {
        validate(
          need(
            all(vapply(adsl_filtered[, input_subgroup_var], is.factor, logical(1))),
            "Not all subgroup variables are factors."
          )
        )
      }
      if (length(input_strata_var) > 0) {
        validate(
          need(
            all(vapply(adsl_filtered[, input_strata_var], is.factor, logical(1))),
            "Not all stratification variables are factors."
          )
        )
      }

      if (!identical(default_responses, c("CR", "PR", "Y", "Complete Response (CR)", "Partial Response (PR)"))) {
        validate(
          need(
            all(unlist(lapply(default_responses, function(x) {
              if (is.list(x) & "levels" %in% names(x)) {
                lvls <- x$levels
                all(x$rsp %in% lvls)
              } else {
                lvls <- unique(anl[[input$`aval_var-dataset_ADRS_singleextract-select`]])
                if ("rsp" %in% names(x)) {
                  all(x$rsp %in% lvls)
                } else {
                  all(x %in% lvls)
                }
              }
            }))),
            "All selected default responses must be in the levels of AVAL."
          )
        )
      }

      if (is.list(default_responses)) {
        validate(
          need(
            all(
              grepl("\\.rsp|\\.levels", names(unlist(default_responses))) |
                names(unlist(default_responses)) %in% names(default_responses)
            ),
            "The lists given for each AVAL in default_responses must be named 'rsp' and 'levels'."
          )
        )
      }

      validate_has_data(anl_q()[["ANL"]], min_nrow = 1)
      NULL
    })

    # The R-code corresponding to the analysis.
    all_q <- reactive({
      validate_checks()
      anl_m <- anl_inputs()

      strata_var <- as.vector(anl_m$columns_source$strata_var)
      subgroup_var <- as.vector(anl_m$columns_source$subgroup_var)

      obj_var_name <- get_g_forest_obj_var_name(paramcd, input)

      my_calls <- template_forest_rsp(
        dataname = "ANL",
        parentname = "ANL_ADSL",
        arm_var = as.vector(anl_m$columns_source$arm_var),
        ref_arm = unlist(input$buckets$Ref),
        comp_arm = unlist(input$buckets$Comp),
        obj_var_name = obj_var_name,
        aval_var = as.vector(anl_m$columns_source$aval_var),
        responders = input$responders,
        subgroup_var = if (length(subgroup_var) != 0) subgroup_var else NULL,
        strata_var = if (length(strata_var) != 0) strata_var else NULL,
        stats = stats,
        riskdiff = riskdiff,
        conf_level = as.numeric(input$conf_level),
        col_symbol_size = `if`(input$fixed_symbol_size, NULL, 1),
        rel_width_forest = input$rel_width_forest / 100,
        font_size = input$font_size,
        ggplot2_args = ggplot2_args
      )

      teal.code::eval_code(anl_q(), as.expression(my_calls))
    })

    plot_r <- reactive(all_q()[["p"]])

    pws <- teal.widgets::plot_with_settings_srv(
      id = "myplot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Forest Response Plot",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Plot", "header3")
        card$append_plot(plot_r(), dim = pws$dim())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Summarize Variables by Row Groups Module
#'
#' Creates a valid expression to generate a table to summarize variables by row groups.
#'
#' @inheritParams template_arguments
#' @param parallel_vars (`logical`)\cr whether summarized variables should be arranged in columns. Can only be set to
#' `TRUE` if all chosen analysis variables are numeric.
#' @param row_groups (`logical`)\cr whether summarized variables should be arranged in row groups.
#' @param drop_zero_levels (`logical`)\cr whether rows with zero counts in all columns should be removed from the table.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_summary_by()]
#'
#' @keywords internal
template_summary_by <- function(parentname,
                                dataname,
                                arm_var,
                                id_var,
                                sum_vars,
                                by_vars,
                                var_labels = character(),
                                add_total = TRUE,
                                total_label = default_total_label(),
                                parallel_vars = FALSE,
                                row_groups = FALSE,
                                na.rm = FALSE, # nolint: object_name.
                                na_level = default_na_str(),
                                numeric_stats = c(
                                  "n", "mean_sd", "mean_ci", "median", "median_ci", "quantiles", "range"
                                ),
                                denominator = c("N", "n", "omit"),
                                drop_arm_levels = TRUE,
                                drop_zero_levels = TRUE,
                                basic_table_args = teal.widgets::basic_table_args()) {
  checkmate::assert_string(parentname)
  checkmate::assert_string(dataname)
  checkmate::assert_string(id_var)
  checkmate::assert_character(sum_vars)
  checkmate::assert_character(by_vars)
  checkmate::assert_character(var_labels)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_flag(parallel_vars)
  checkmate::assert_flag(row_groups)
  checkmate::assert_flag(na.rm)
  checkmate::assert_string(na_level)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_character(numeric_stats)
  checkmate::assert_flag(drop_zero_levels)
  checkmate::assert_character(arm_var, min.len = 1, max.len = 2)

  denominator <- match.arg(denominator)

  y <- list()

  # Data processing
  data_list <- list()

  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl <- df %>%
        df_explicit_na(omit_columns = setdiff(names(df), c(by_vars, sum_vars)), na_level = na_str),
      env = list(
        df = as.name(dataname),
        by_vars = by_vars,
        sum_vars = sum_vars,
        na_str = na_level
      )
    )
  )

  prepare_arm_levels_call <- lapply(arm_var, function(x) {
    prepare_arm_levels(
      dataname = "anl",
      parentname = parentname,
      arm_var = x,
      drop_arm_levels = drop_arm_levels
    )
  })
  data_list <- Reduce(add_expr, prepare_arm_levels_call, init = data_list)

  data_list <- add_expr(
    data_list,
    substitute(
      expr = parentname <- df_explicit_na(parentname, na_level = na_str),
      env = list(parentname = as.name(parentname), na_str = na_level)
    )
  )

  y$data <- bracket_expr(data_list)

  # Build layout
  y$layout_prep <- quote(split_fun <- drop_split_levels)
  if (row_groups) {
    y$layout_cfun <- quote(
      cfun_unique <- function(x, labelstr = "", .N_col) { # nolint: object_name.
        y <- length(unique(x))
        rcell(
          c(y, y / .N_col),
          label = labelstr
        )
      }
    )
  }

  table_title <- paste("Summary Table for", paste(sum_vars, collapse = ", "), "by", paste(by_vars, collapse = ", "))

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(show_colcounts = TRUE, title = table_title)
    )
  )

  layout_list <- list()
  layout_list <- add_expr(
    layout_list,
    parsed_basic_table_args
  )

  split_cols_call <- lapply(arm_var, function(x) {
    if (drop_arm_levels) {
      substitute(
        expr = rtables::split_cols_by(x, split_fun = drop_split_levels),
        env = list(x = x)
      )
    } else {
      substitute(
        expr = rtables::split_cols_by(x),
        env = list(x = x)
      )
    }
  })
  layout_list <- Reduce(add_expr, split_cols_call, init = layout_list)

  if (add_total && !parallel_vars) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = rtables::add_overall_col(total_label),
        env = list(total_label = total_label)
      )
    )
  }

  env_vars <- list(
    sum_vars = sum_vars,
    sum_var_labels = var_labels[sum_vars],
    na.rm = na.rm,
    na_level = na_level,
    denom = ifelse(denominator == "n", "n", "N_col"),
    stats = c(
      numeric_stats,
      ifelse(denominator == "omit", "count", "count_fraction")
    )
  )

  for (by_var in by_vars) {
    split_label <- substitute(
      expr = teal.data::col_labels(dataname, fill = FALSE)[[by_var]],
      env = list(
        dataname = as.name(dataname),
        by_var = by_var
      )
    )

    layout_list <- add_expr(
      layout_list,
      substitute(
        rtables::split_rows_by(
          by_var,
          split_label = split_label,
          split_fun = split_fun,
          label_pos = "topleft"
        ),
        env = list(
          by_var = by_var,
          split_label = split_label
        )
      )
    )

    if (row_groups) {
      layout_list <- add_expr(
        layout_list,
        substitute(
          expr = rtables::summarize_row_groups(var = id_var, cfun = cfun_unique, na_str = na_str),
          env = list(
            id_var = id_var,
            na_str = na_level
          )
        )
      )
    }
  }

  if (parallel_vars) {
    layout_list <- add_expr(
      layout_list,
      if (length(var_labels) > 0) {
        substitute(
          expr = split_cols_by_multivar(vars = sum_vars, varlabels = sum_var_labels),
          env = list(sum_vars = sum_vars, sum_var_labels = var_labels[sum_vars])
        )
      } else {
        substitute(
          expr = split_cols_by_multivar(vars = sum_vars),
          env = list(sum_vars = sum_vars)
        )
      }
    )
  }

  if (row_groups) {
    layout_list <- layout_list
  } else {
    layout_list <- add_expr(
      layout_list,
      if (parallel_vars) {
        if (length(var_labels) > 0) {
          substitute(
            expr = summarize_colvars(
              na.rm = na.rm,
              denom = denom,
              .stats = stats,
              na_str = na_level
            ),
            env = env_vars
          )
        } else {
          substitute(
            expr = summarize_colvars(
              vars = sum_vars,
              na.rm = na.rm,
              denom = denom,
              .stats = stats,
              na_str = na_level
            ),
            env = env_vars
          )
        }
      } else {
        if (length(var_labels > 0)) {
          substitute(
            expr = analyze_vars(
              vars = sum_vars,
              var_labels = sum_var_labels,
              na.rm = na.rm,
              na_str = na_level,
              denom = denom,
              .stats = stats
            ),
            env = env_vars
          )
        } else {
          substitute(
            expr = analyze_vars(
              vars = sum_vars,
              na.rm = na.rm,
              na_str = na_level,
              denom = denom,
              .stats = stats
            ),
            env = env_vars
          )
        }
      }
    )
  }

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  if (drop_zero_levels) {
    y$table <- substitute(
      expr = {
        all_zero <- function(tr) {
          if (!inherits(tr, "TableRow") || inherits(tr, "LabelRow")) {
            return(FALSE)
          }
          rvs <- unlist(unname(row_values(tr)))
          isTRUE(all(rvs == 0))
        }
        result <- rtables::build_table(
          lyt = lyt,
          df = anl,
          alt_counts_df = parent
        ) %>% rtables::trim_rows(criteria = all_zero)
        result
      },
      env = list(parent = as.name(parentname))
    )
  } else {
    y$table <- substitute(
      expr = {
        result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
        result
      },
      env = list(parent = as.name(parentname))
    )
  }

  y
}

#' teal Module: Summarize Variables by Row Groups
#'
#' This module produces a table to summarize variables by row groups.
#'
#' @inheritParams module_arguments
#' @inheritParams template_summary_by
#' @param arm_var ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for variable names that can be used as `arm_var`.
#'   It defines the grouping variable(s) in the results table.
#'   If there are two elements selected for `arm_var`,
#'   second variable will be nested under the first variable.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' ADSL <- tmc_ex_adsl
#' ADLB <- tmc_ex_adlb
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADLB = ADLB,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADLB <- tmc_ex_adlb
#'     "
#'   ),
#'   modules = modules(
#'     tm_t_summary_by(
#'       label = "Summary by Row Groups Table",
#'       dataname = "ADLB",
#'       arm_var = choices_selected(
#'         choices = variable_choices(ADSL, c("ARM", "ARMCD")),
#'         selected = "ARM"
#'       ),
#'       add_total = TRUE,
#'       by_vars = choices_selected(
#'         choices = variable_choices(ADLB, c("PARAM", "AVISIT")),
#'         selected = c("AVISIT")
#'       ),
#'       summarize_vars = choices_selected(
#'         choices = variable_choices(ADLB, c("AVAL", "CHG")),
#'         selected = c("AVAL")
#'       ),
#'       useNA = "ifany",
#'       paramcd = choices_selected(
#'         choices = value_choices(ADLB, "PARAMCD", "PARAM"),
#'         selected = "ALT"
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_summary_by <- function(label,
                            dataname,
                            parentname = ifelse(
                              inherits(arm_var, "data_extract_spec"),
                              teal.transform::datanames_input(arm_var),
                              "ADSL"
                            ),
                            arm_var,
                            by_vars,
                            summarize_vars,
                            id_var = teal.transform::choices_selected(
                              teal.transform::variable_choices(dataname, subset = "USUBJID"),
                              selected = "USUBJID", fixed = TRUE
                            ),
                            paramcd = NULL,
                            add_total = TRUE,
                            total_label = default_total_label(),
                            parallel_vars = FALSE,
                            row_groups = FALSE,
                            useNA = c("ifany", "no"), # nolint: object_name.
                            na_level = default_na_str(),
                            numeric_stats = c("n", "mean_sd", "median", "range"),
                            denominator = teal.transform::choices_selected(c("n", "N", "omit"), "omit", fixed = TRUE),
                            drop_arm_levels = TRUE,
                            drop_zero_levels = TRUE,
                            pre_output = NULL,
                            post_output = NULL,
                            basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_summary_by")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  useNA <- match.arg(useNA) # nolint: object_name.
  checkmate::assert_string(na_level)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(by_vars, "choices_selected")
  checkmate::assert_class(summarize_vars, "choices_selected")
  checkmate::assert_class(id_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(denominator, "choices_selected")
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_flag(drop_zero_levels)
  checkmate::assert_subset(denominator$choices, choices = c("n", "N", "omit"))
  checkmate::assert_flag(parallel_vars)
  checkmate::assert_flag(row_groups)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_character(numeric_stats, min.len = 1)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  numeric_stats_choices <- c("n", "mean_sd", "mean_ci", "geom_mean", "median", "median_ci", "quantiles", "range")
  numeric_stats <- match.arg(numeric_stats, numeric_stats_choices, several.ok = TRUE)

  args <- c(as.list(environment()))

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname, multiple = TRUE, ordered = TRUE),
    id_var = cs_to_des_select(id_var, dataname = dataname),
    paramcd = `if`(
      is.null(paramcd),
      NULL,
      cs_to_des_filter(paramcd, dataname = dataname, multiple = TRUE)
    ),
    by_vars = cs_to_des_select(by_vars, dataname = dataname, multiple = TRUE, ordered = TRUE),
    summarize_vars = cs_to_des_select(summarize_vars, dataname = dataname, multiple = TRUE, ordered = TRUE)
  )

  module(
    label = label,
    ui = ui_summary_by,
    ui_args = c(data_extract_list, args),
    server = srv_summary_by,
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        total_label = total_label,
        na_level = na_level,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_summary_by <- function(id, ...) {
  ns <- NS(id)
  a <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$arm_var,
    a$id_var,
    a$paramcd,
    a$by_vars,
    a$summarize_vars
  )

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c("arm_var", "id_var", "paramcd", "by_vars", "summarize_vars")]),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      checkboxInput(ns("add_total"), "Add All Patients column", value = a$add_total),
      `if`(
        is.null(a$paramcd),
        NULL,
        teal.transform::data_extract_ui(
          id = ns("paramcd"),
          label = "Select Endpoint",
          data_extract_spec = a$paramcd,
          is_single_dataset = is_single_dataset_value
        )
      ),
      teal.transform::data_extract_ui(
        id = ns("by_vars"),
        label = "Row By Variable",
        data_extract_spec = a$by_vars,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("summarize_vars"),
        label = "Summarize Variables",
        data_extract_spec = a$summarize_vars,
        is_single_dataset = is_single_dataset_value
      ),
      checkboxInput(ns("parallel_vars"), "Show summarize variables in parallel", value = a$parallel_vars),
      checkboxInput(ns("row_groups"), "Summarize number of subjects in row groups", value = a$row_groups),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional table settings",
          checkboxInput(ns("drop_zero_levels"), "Drop rows with 0 count", value = a$drop_zero_levels),
          radioButtons(
            ns("useNA"),
            label = "Display NA counts",
            choices = c("ifany", "no"),
            selected = a$useNA
          ),
          teal.widgets::optionalSelectInput(
            inputId = ns("denominator"),
            label = "Denominator choice",
            choices = a$denominator$choices,
            selected = a$denominator$selected,
            fixed = a$denominator$fixed
          ),
          checkboxGroupInput(
            ns("numeric_stats"),
            label = "Choose the statistics to display for numeric variables",
            choices = c(
              "n" = "n",
              "Mean (SD)" = "mean_sd",
              "Mean 95% CI" = "mean_ci",
              "Geometric Mean" = "geom_mean",
              "Median" = "median",
              "Median 95% CI" = "median_ci",
              "25% and 75%-ile" = "quantiles",
              "Min - Max" = "range"
            ),
            selected = a$numeric_stats
          ),
          if (a$dataname == a$parentname) {
            shinyjs::hidden(
              checkboxInput(
                ns("drop_arm_levels"),
                label = "it's a BUG if you see this",
                value = TRUE
              )
            )
          } else {
            checkboxInput(
              ns("drop_arm_levels"),
              label = sprintf("Drop columns not in filtered %s", a$dataname),
              value = a$drop_arm_levels
            )
          }
        )
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional Variables Info",
          teal.transform::data_extract_ui(
            id = ns("id_var"),
            label = "Subject Identifier",
            data_extract_spec = a$id_var,
            is_single_dataset = is_single_dataset_value
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_summary_by <- function(id,
                           data,
                           reporter,
                           filter_panel_api,
                           dataname,
                           parentname,
                           arm_var,
                           id_var,
                           paramcd,
                           by_vars,
                           summarize_vars,
                           add_total,
                           total_label,
                           na_level,
                           drop_arm_levels,
                           drop_zero_levels,
                           label,
                           basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    vars <- list(arm_var = arm_var, id_var = id_var, summarize_vars = summarize_vars, by_vars = by_vars)

    if (!is.null(paramcd)) {
      vars[["paramcd"]] <- paramcd
    }

    validation_rules <- list(
      arm_var = ~ if (length(.) != 1 && length(.) != 2) {
        "Please select 1 or 2 column variables"
      },
      id_var = shinyvalidate::sv_required("Please select a subject identifier."),
      summarize_vars = shinyvalidate::sv_required("Please select a summarize variable.")
    )

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = vars,
      datasets = data,
      select_validation_rule = validation_rules,
      filter_validation_rule = list(paramcd = shinyvalidate::sv_required(message = "Please select a filter."))
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("numeric_stats", shinyvalidate::sv_required("Please select at least one statistic to display."))
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      selector_list = selector_list,
      datasets = data,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      id = "adsl_merge",
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    # Prepare the analysis environment (filter data, check data, populate envir).
    validate_checks <- reactive({
      teal::validate_inputs(iv_r())
      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]

      input_arm_var <- names(merged$anl_input_r()$columns_source$arm_var)
      input_id_var <- names(merged$anl_input_r()$columns_source$id_var)
      input_by_vars <- names(merged$anl_input_r()$columns_source$by_vars)
      input_summarize_vars <- names(merged$anl_input_r()$columns_source$summarize_var)
      input_paramcd <- `if`(is.null(paramcd), NULL, unlist(paramcd$filter)["vars_selected"])

      # validate inputs
      validate_standard_inputs(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_paramcd, input_by_vars, input_summarize_vars, input_id_var),
        arm_var = input_arm_var[[1]]
      )

      if (input$parallel_vars) {
        validate(shiny::need(
          all(vapply(anl_filtered[input_summarize_vars], is.numeric, logical(1))),
          "Summarize variables must all be numeric to display in parallel columns."
        ))
      }
    })

    # The R-code corresponding to the analysis.
    all_q <- reactive({
      validate_checks()
      summarize_vars <- as.vector(merged$anl_input_r()$columns_source$summarize_vars)
      var_labels <- teal.data::col_labels(merged$anl_q()[[dataname]][, summarize_vars, drop = FALSE])

      my_calls <- template_summary_by(
        parentname = "ANL_ADSL",
        dataname = "ANL",
        arm_var = as.vector(merged$anl_input_r()$columns_source$arm_var),
        sum_vars = summarize_vars,
        by_vars = as.vector(merged$anl_input_r()$columns_source$by_vars),
        var_labels = var_labels,
        id_var = as.vector(merged$anl_input_r()$columns_source$id_var),
        na.rm = ifelse(input$useNA == "ifany", FALSE, TRUE),
        na_level = na_level,
        numeric_stats = input$numeric_stats,
        denominator = input$denominator,
        add_total = input$add_total,
        total_label = total_label,
        parallel_vars = input$parallel_vars,
        row_groups = input$row_groups,
        drop_arm_levels = input$drop_arm_levels,
        drop_zero_levels = input$drop_zero_levels,
        basic_table_args = basic_table_args
      )

      teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
    })

    # Outputs to render.
    table_r <- reactive(all_q()[["result"]])

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    # Render R code.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Summarize Variables by Row Groups Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Binary Outcome
#'
#' Creates a valid expression to generate a binary outcome analysis.
#'
#' @inheritParams template_arguments
#' @param responder_val (`character`)\cr the short label for observations to
#'   translate `AVALC` into responder/non-responder.
#' @param responder_val_levels (`character`)\cr the levels of responses that will be shown in the multinomial
#'   response estimations.
#' @param show_rsp_cat (`logical`)\cr display the multinomial response estimations.
#' @param paramcd (`character`)\cr response parameter value to use in the table title.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_binary_outcome()]
#'
#' @keywords internal
template_binary_outcome <- function(dataname,
                                    parentname,
                                    arm_var,
                                    paramcd,
                                    ref_arm = NULL,
                                    comp_arm = NULL,
                                    compare_arm = FALSE,
                                    combine_comp_arms = FALSE,
                                    aval_var = "AVALC",
                                    show_rsp_cat = TRUE,
                                    responder_val = c("Complete Response (CR)", "Partial Response (PR)"),
                                    responder_val_levels = responder_val,
                                    control = list(
                                      global = list(method = "waldcc", conf_level = 0.95),
                                      unstrat = list(method_ci = "waldcc", method_test = "schouten", odds = TRUE),
                                      strat = list(method_ci = "cmh", method_test = "cmh", strat = NULL)
                                    ),
                                    add_total = FALSE,
                                    total_label = default_total_label(),
                                    na_level = default_na_str(),
                                    basic_table_args = teal.widgets::basic_table_args()) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(arm_var)
  checkmate::assert_string(aval_var)
  checkmate::assert_flag(compare_arm)
  checkmate::assert_flag(combine_comp_arms)
  checkmate::assert_flag(show_rsp_cat)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(na_level)
  checkmate::assert_string(total_label)

  ref_arm_val <- paste(ref_arm, collapse = "/")
  y <- list()

  data_list <- list()

  data_list <- add_expr(
    data_list,
    prepare_arm(
      dataname = dataname,
      arm_var = arm_var,
      ref_arm = ref_arm,
      comp_arm = comp_arm,
      ref_arm_val = ref_arm_val,
      compare_arm = compare_arm
    )
  )

  data_list <- add_expr(
    data_list,
    substitute_names(
      expr = dplyr::mutate(is_rsp = aval_var %in% responder_val) %>%
        dplyr::mutate(aval = factor(aval_var, levels = responder_val_levels)),
      names = list(
        aval = as.name(aval_var)
      ),
      others = list(
        responder_val = responder_val,
        responder_val_levels = responder_val_levels,
        aval_var = as.name(aval_var)
      )
    )
  )

  y$data <- substitute(
    expr = {
      anl <- data_pipe
      parentname <- arm_preparation %>% df_explicit_na(na_level = na_str)
    },
    env = list(
      data_pipe = pipe_expr(data_list),
      parentname = as.name(parentname),
      arm_preparation = prepare_arm(
        dataname = parentname,
        arm_var = arm_var,
        ref_arm = ref_arm,
        comp_arm = comp_arm,
        ref_arm_val = ref_arm_val,
        compare_arm = compare_arm
      ),
      na_str = na_level
    )
  )

  if (compare_arm && combine_comp_arms) {
    y$combine_comp_arms <- substitute(
      expr = groups <- combine_groups(fct = df[[group]], ref = ref_arm_val),
      env = list(
        df = as.name(parentname),
        group = arm_var,
        ref_arm_val = ref_arm_val
      )
    )
  }

  table_title <- if (length(responder_val) > 1) {
    paste(
      "Table of", paramcd, "for", paste(utils::head(responder_val, -1), collapse = ", "),
      "and", utils::tail(responder_val, 1), "Responders"
    )
  } else {
    paste("Table of", paramcd, "for", responder_val, "Responders")
  }

  strata_var <- control$strat$strat
  subtitle <- ifelse(length(strata_var) == 0, "", paste("Stratified by", paste(strata_var, collapse = " and ")))

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(
        show_colcounts = TRUE,
        title = table_title,
        subtitles = subtitle
      )
    )
  )

  layout_list <- list()
  layout_list <- add_expr(
    layout_list,
    parsed_basic_table_args
  )

  if (!compare_arm && !combine_comp_arms && add_total) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        rtables::split_cols_by(
          var = arm_var,
          split_fun = add_overall_level(total_label, first = FALSE)
        ),
        env = list(
          arm_var = arm_var,
          total_label = total_label
        )
      )
    )
  } else {
    layout_list <- add_expr(
      layout_list,
      split_col_expr(
        compare = compare_arm,
        combine = combine_comp_arms,
        arm_var = arm_var,
        ref = ref_arm_val
      )
    )
  }

  layout_list <- add_expr(
    layout_list,
    substitute(
      estimate_proportion(
        vars = "is_rsp",
        conf_level = conf_level,
        method = method,
        table_names = "prop_est"
      ),
      env = list(
        conf_level = control$global$conf_level,
        method = control$global$method
      )
    )
  )

  if (compare_arm) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = estimate_proportion_diff(
          vars = "is_rsp", show_labels = "visible",
          var_labels = "Unstratified Analysis",
          conf_level = conf_level,
          method = method_ci,
          table_names = "u_prop_diff"
        ) %>%
          test_proportion_diff(
            vars = "is_rsp",
            method = method_test,
            table_names = "u_test_diff"
          ),
        env = list(
          conf_level = control$global$conf_level,
          method_ci = control$unstrat$method_ci,
          method_test = control$unstrat$method_test
        )
      )
    )

    if (control$unstrat$odds) {
      layout_list <- add_expr(
        layout_list,
        substitute(
          expr = estimate_odds_ratio(
            vars = "is_rsp",
            conf_level = conf_level,
            table_names = "u_est_or"
          ),
          env = list(conf_level = control$global$conf_level)
        )
      )
    }

    if (!is.null(control$strat$strat)) {
      layout_list <- add_expr(
        layout_list,
        substitute(
          expr = estimate_proportion_diff(
            vars = "is_rsp", show_labels = "visible",
            var_labels = "Stratified Analysis",
            variables = list(strata = strata),
            conf_level = conf_level,
            method = method_ci,
            table_names = "s_prop_diff"
          ) %>%
            test_proportion_diff(
              vars = "is_rsp",
              method = method_test,
              variables = list(strata = strata),
              table_names = "s_test_diff"
            ),
          env = list(
            conf_level = control$global$conf_level,
            method_ci = control$strat$method_ci,
            strata = control$strat$strat,
            method_test = control$strat$method_test,
            arm_var = arm_var
          )
        )
      )
    }
  }

  if (compare_arm && !is.null(control$strat$strat)) {
    layout_list <- if (combine_comp_arms) {
      add_expr(
        layout_list,
        substitute(
          expr = estimate_odds_ratio(
            vars = "is_rsp",
            variables = list(arm = arm_var, strata = strata),
            conf_level = conf_level,
            table_names = "s_est_or",
            groups_list = groups
          ),
          env = list(
            conf_level = control$global$conf_level,
            strata = control$strat$strat,
            arm_var = arm_var
          )
        )
      )
    } else {
      add_expr(
        layout_list,
        substitute(
          expr = estimate_odds_ratio(
            vars = "is_rsp",
            variables = list(arm = arm_var, strata = strata),
            conf_level = conf_level,
            table_names = "s_est_or"
          ),
          env = list(
            conf_level = control$global$conf_level,
            strata = control$strat$strat,
            arm_var = arm_var
          )
        )
      )
    }
  }

  if (show_rsp_cat) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        estimate_multinomial_response(
          var = aval_var,
          conf_level = conf_level,
          method = method
        ),
        list(
          conf_level = control$global$conf_level,
          method = control$global$method,
          aval_var = aval_var
        )
      )
    )
  }

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  y$table <- substitute(
    expr = {
      result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parentname)
      result
    },
    env = list(parentname = as.name(parentname))
  )
  y
}

#' teal Module: Binary Outcome Table
#'
#' This module produces a binary outcome response summary table, with the option to match the template for
#' response table `RSPT01` available in the TLG Catalog [here](
#' https://insightsengineering.github.io/tlg-catalog/stable/tables/efficacy/rspt01.html).
#'
#' @inheritParams module_arguments
#' @inheritParams template_binary_outcome
#' @param rsp_table (`logical`)\cr whether the initial set-up of the module should match `RSPT01`. Defaults to `FALSE`.
#' @param control (named `list`)\cr named list containing 3 named lists as follows:
#'   * `global`: a list of settings for overall analysis with 2 named elements `method` and `conf_level`.
#'   * `unstrat`: a list of settings for unstratified analysis with 3 named elements `method_ci` and `method_test`, and
#'     `odds`. See [tern::estimate_proportion_diff()], [tern::test_proportion_diff()], and
#'     [tern::estimate_odds_ratio()], respectively, for options and details on how these settings are implemented in the
#'     analysis.
#'   * `strat`: a list of settings for stratified analysis with elements `method_ci` and `method_test`. See
#'     [tern::estimate_proportion_diff()] and [tern::test_proportion_diff()], respectively, for options and details on
#'     how these settings are implemented in the analysis.
#'
#' @details
#' * The display order of response categories inherits the factor level order of the source data. Use
#'   [base::factor()] and its `levels` argument to manipulate the source data in order to include/exclude
#'   or re-categorize response categories and arrange the display order. If response categories are `"Missing"`,
#'   `"Not Evaluable (NE)"`, or `"Missing or unevaluable"`, 95% confidence interval will not be calculated.
#'
#' * Reference arms are automatically combined if multiple arms selected as reference group.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' library(dplyr)
#'
#' ADSL <- tmc_ex_adsl
#' ADRS <- tmc_ex_adrs %>%
#'   mutate(
#'     AVALC = d_onco_rsp_label(AVALC) %>%
#'       with_label("Character Result/Finding")
#'   ) %>%
#'   filter(PARAMCD != "OVRINV" | AVISIT == "FOLLOW UP")
#'
#' arm_ref_comp <- list(
#'   ARMCD = list(ref = "ARM B", comp = c("ARM A", "ARM C")),
#'   ARM = list(ref = "B: Placebo", comp = c("A: Drug X", "C: Combination"))
#' )
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADRS = ADRS,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADRS <- tmc_ex_adrs %>%
#'         mutate(
#'           AVALC = d_onco_rsp_label(AVALC) %>%
#'             with_label(\"Character Result/Finding\")
#'         ) %>%
#'         filter(PARAMCD != \"OVRINV\" | AVISIT == \"FOLLOW UP\")
#'     "
#'   ),
#'   modules = modules(
#'     tm_t_binary_outcome(
#'       label = "Responders",
#'       dataname = "ADRS",
#'       paramcd = choices_selected(
#'         choices = value_choices(ADRS, "PARAMCD", "PARAM"),
#'         selected = "BESRSPI"
#'       ),
#'       arm_var = choices_selected(
#'         choices = variable_choices(ADRS, c("ARM", "ARMCD", "ACTARMCD")),
#'         selected = "ARM"
#'       ),
#'       arm_ref_comp = arm_ref_comp,
#'       strata_var = choices_selected(
#'         choices = variable_choices(ADRS, c("SEX", "BMRKR2", "RACE")),
#'         selected = "RACE"
#'       ),
#'       default_responses = list(
#'         BESRSPI = list(
#'           rsp = c("Complete Response (CR)", "Partial Response (PR)"),
#'           levels = c(
#'             "Complete Response (CR)", "Partial Response (PR)",
#'             "Stable Disease (SD)", "Progressive Disease (PD)"
#'           )
#'         ),
#'         INVET = list(
#'           rsp = c("Stable Disease (SD)", "Not Evaluable (NE)"),
#'           levels = c(
#'             "Complete Response (CR)", "Not Evaluable (NE)", "Partial Response (PR)",
#'             "Progressive Disease (PD)", "Stable Disease (SD)"
#'           )
#'         ),
#'         OVRINV = list(
#'           rsp = c("Progressive Disease (PD)", "Stable Disease (SD)"),
#'           levels = c("Progressive Disease (PD)", "Stable Disease (SD)", "Not Evaluable (NE)")
#'         )
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_binary_outcome <- function(label,
                                dataname,
                                parentname = ifelse(
                                  test = inherits(arm_var, "data_extract_spec"),
                                  yes = teal.transform::datanames_input(arm_var),
                                  no = "ADSL"
                                ),
                                arm_var,
                                arm_ref_comp = NULL,
                                paramcd,
                                strata_var,
                                aval_var = teal.transform::choices_selected(
                                  choices = teal.transform::variable_choices(dataname, c("AVALC", "SEX")),
                                  selected = "AVALC", fixed = FALSE
                                ),
                                conf_level = teal.transform::choices_selected(
                                  c(0.95, 0.9, 0.8), 0.95,
                                  keep_order = TRUE
                                ),
                                default_responses =
                                  c("CR", "PR", "Y", "Complete Response (CR)", "Partial Response (PR)", "M"),
                                rsp_table = FALSE,
                                control = list(
                                  global = list(
                                    method = ifelse(rsp_table, "clopper-pearson", "waldcc"),
                                    conf_level = 0.95
                                  ),
                                  unstrat = list(
                                    method_ci = ifelse(rsp_table, "wald", "waldcc"),
                                    method_test = "schouten",
                                    odds = TRUE
                                  ),
                                  strat = list(method_ci = "cmh", method_test = "cmh")
                                ),
                                add_total = FALSE,
                                total_label = default_total_label(),
                                na_level = default_na_str(),
                                pre_output = NULL,
                                post_output = NULL,
                                basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_binary_outcome")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(strata_var, "choices_selected")
  checkmate::assert_class(aval_var, "choices_selected")
  checkmate::assert_class(conf_level, "choices_selected")
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_string(na_level)
  checkmate::assert(
    checkmate::check_class(default_responses, classes = "list"),
    checkmate::check_class(default_responses, classes = "character"),
    checkmate::check_class(default_responses, classes = "numeric"),
    checkmate::check_class(default_responses, classes = "NULL")
  )
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  # control checks
  checkmate::assert_names(names(control), permutation.of = c("global", "unstrat", "strat"))
  checkmate::assert_names(names(control$global), permutation.of = c("method", "conf_level"))
  checkmate::assert_names(names(control$unstrat), permutation.of = c("method_ci", "method_test", "odds"))
  checkmate::assert_names(names(control$strat), permutation.of = c("method_ci", "method_test"))
  checkmate::assert_subset(
    control$global$method,
    c("wald", "waldcc", "clopper-pearson", "wilson", "wilsonc", "jeffreys", "agresti-coull")
  )
  checkmate::assert_number(control$global$conf_level, lower = 0, upper = 1)
  checkmate::assert_subset(control$unstrat$method_ci, c("wald", "waldcc", "ha", "newcombe", "newcombecc"))
  checkmate::assert_subset(control$unstrat$method_test, c("chisq", "fisher", "schouten"))
  checkmate::assert_logical(control$unstrat$odds)
  checkmate::assert_subset(
    control$strat$method_ci, c("wald", "waldcc", "cmh", "ha", "strat_newcombe", "strat_newcombecc")
  )
  checkmate::assert_subset(control$strat$method_test, c("cmh"))

  args <- as.list(environment())

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname),
    aval_var = cs_to_des_select(aval_var, dataname = dataname),
    strata_var = cs_to_des_select(strata_var, dataname = parentname, multiple = TRUE)
  )

  module(
    label = label,
    ui = ui_t_binary_outcome,
    ui_args = c(data_extract_list, args),
    server = srv_t_binary_outcome,
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        arm_ref_comp = arm_ref_comp,
        label = label,
        total_label = total_label,
        default_responses = default_responses,
        control = control,
        rsp_table = rsp_table,
        na_level = na_level,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_t_binary_outcome <- function(id, ...) {
  a <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$paramcd,
    a$arm_var,
    a$aval_var,
    a$strata_var
  )

  ns <- NS(id)
  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c("paramcd", "arm_var", "aval_var", "strata_var")]),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Parameter",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      selectInput(
        ns("responders"),
        "Responders",
        choices = NULL,
        selected = NULL,
        multiple = TRUE
      ),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      tags$div(
        class = "arm-comp-box",
        tags$label("Compare Treatments"),
        shinyWidgets::switchInput(
          inputId = ns("compare_arms"),
          value = !is.null(a$arm_ref_comp),
          size = "mini"
        ),
        conditionalPanel(
          condition = paste0("input['", ns("compare_arms"), "']"),
          tags$div(
            uiOutput(
              ns("arms_buckets"),
              title = paste(
                "Multiple reference groups are automatically combined into a single group when more than one",
                "value is selected."
              )
            ),
            helpText("Multiple reference groups are automatically combined into a single group."),
            checkboxInput(
              ns("combine_comp_arms"),
              "Combine all comparison groups?",
              value = FALSE
            )
          )
        )
      ),
      conditionalPanel(
        condition = paste0("input['", ns("compare_arms"), "']"),
        teal.widgets::panel_group(
          teal.widgets::panel_item(
            "Unstratified analysis settings",
            teal.widgets::optionalSelectInput(
              ns("u_diff_ci"),
              label = "Method for Difference of Proportions CI",
              choices = c(
                "Wald, without correction" = "wald",
                "Wald, with correction" = "waldcc",
                "Anderson-Hauck" = "ha",
                "Newcombe, without correction" = "newcombe",
                "Newcombe, with correction" = "newcombecc"
              ),
              selected = a$control$unstrat$method_ci,
              multiple = FALSE,
              fixed = FALSE
            ),
            teal.widgets::optionalSelectInput(
              ns("u_diff_test"),
              label = "Method for Difference of Proportions Test",
              choices = c(
                "Chi-squared Test" = "chisq",
                "Fisher's Exact Test" = "fisher",
                "Chi-Squared Test with Schouten correction" = "schouten"
              ),
              selected = a$control$unstrat$method_test,
              multiple = FALSE,
              fixed = FALSE
            ),
            tags$label("Odds Ratio Estimation"),
            shinyWidgets::switchInput(
              inputId = ns("u_odds_ratio"), value = a$control$unstrat$odds, size = "mini"
            )
          )
        ),
        teal.widgets::panel_group(
          teal.widgets::panel_item(
            "Stratified analysis settings",
            teal.transform::data_extract_ui(
              id = ns("strata_var"),
              label = "Stratification Factors",
              data_extract_spec = a$strata_var,
              is_single_dataset = is_single_dataset_value
            ),
            teal.widgets::optionalSelectInput(
              ns("s_diff_ci"),
              label = "Method for Difference of Proportions CI",
              choices = c(
                "Wald, without correction" = "wald",
                "Wald, with correction" = "waldcc",
                "CMH, without correction" = "cmh",
                "Anderson-Hauck" = "ha",
                "Stratified Newcombe, without correction" = "strat_newcombe",
                "Stratified Newcombe, with correction" = "strat_newcombecc"
              ),
              selected = a$control$strat$method_ci,
              multiple = FALSE
            ),
            teal.widgets::optionalSelectInput(
              ns("s_diff_test"),
              label = "Method for Difference of Proportions Test",
              choices = c("CMH Test" = "cmh"),
              selected = a$control$strat$method_test,
              multiple = FALSE,
              fixed = TRUE
            )
          )
        )
      ),
      conditionalPanel(
        condition = paste0("!input['", ns("compare_arms"), "']"),
        checkboxInput(ns("add_total"), "Add All Patients column", value = a$add_total)
      ),
      teal.widgets::panel_item(
        "Additional table settings",
        teal.widgets::optionalSelectInput(
          inputId = ns("prop_ci_method"),
          label = "Method for Proportion CI",
          choices = c(
            "Wald, without correction" = "wald",
            "Wald, with correction" = "waldcc",
            "Clopper-Pearson" = "clopper-pearson",
            "Wilson" = "wilson",
            "Wilson, with correction" = "wilsonc",
            "Jeffreys" = "jeffreys",
            "Agresti-Coull" = "agresti-coull"
          ),
          selected = a$control$global$method,
          multiple = FALSE,
          fixed = FALSE
        ),
        teal.widgets::optionalSelectInput(
          inputId = ns("conf_level"),
          label = "Confidence Level",
          a$conf_level$choices,
          a$conf_level$selected,
          multiple = FALSE,
          fixed = a$conf_level$fixed
        ),
        tags$label("Show All Response Categories"),
        shinyWidgets::switchInput(
          inputId = ns("show_rsp_cat"),
          value = ifelse(a$rsp_table, TRUE, FALSE),
          size = "mini"
        )
      ),
      teal.transform::data_extract_ui(
        id = ns("aval_var"),
        label = "Analysis Variable",
        data_extract_spec = a$aval_var,
        is_single_dataset = is_single_dataset_value
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_t_binary_outcome <- function(id,
                                 data,
                                 reporter,
                                 filter_panel_api,
                                 dataname,
                                 parentname,
                                 paramcd,
                                 aval_var,
                                 arm_var,
                                 arm_ref_comp,
                                 strata_var,
                                 add_total,
                                 control,
                                 total_label,
                                 label,
                                 default_responses,
                                 rsp_table,
                                 na_level,
                                 basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    # Setup arm variable selection, default reference arms, and default
    # comparison arms for encoding panel
    iv_arm_ref <- arm_ref_comp_observer(
      session,
      input,
      output,
      id_arm_var = extract_input("arm_var", parentname),
      data = data()[[parentname]],
      arm_ref_comp = arm_ref_comp,
      module = "tm_t_binary_outcome",
      on_off = reactive(input$compare_arms)
    )

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(arm_var = arm_var, paramcd = paramcd, strata_var = strata_var, aval_var = aval_var),
      datasets = data,
      select_validation_rule = list(
        aval_var = shinyvalidate::sv_required("An analysis variable is required"),
        arm_var = shinyvalidate::sv_required("A treatment variable is required")
      ),
      filter_validation_rule = list(paramcd = shinyvalidate::sv_required(message = "Please select a filter."))
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()

      if (isTRUE(input$compare_arms)) {
        iv$add_validator(iv_arm_ref)
      }

      iv$add_rule("responders", shinyvalidate::sv_required("`Responders` field is empty"))
      iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level between 0 and 1"))
      iv$add_rule(
        "conf_level",
        shinyvalidate::sv_between(0, 1, message_fmt = "Please choose a confidence level between {left} and {right}")
      )
      teal.transform::compose_and_enable_validators(iv, selector_list, c("arm_var", "aval_var", "paramcd"))
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var, strata_var = strata_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    observeEvent(
      c(
        input[[extract_input("aval_var", "ADRS")]],
        input[[extract_input("paramcd", paramcd$filter[[1]]$dataname, filter = TRUE)]]
      ),
      handlerExpr = {
        anl <- anl_q()[["ANL"]]
        aval_var <- anl_inputs()$columns_source$aval_var
        paramcd <- input[[extract_input("paramcd", paramcd$filter[[1]]$dataname, filter = TRUE)]]
        sel_param <- if (is.list(default_responses) && (!is.null(paramcd))) {
          default_responses[[paramcd]]
        } else {
          default_responses
        }
        common_rsp <- if (is.list(sel_param)) {
          sel_param$rsp
        } else {
          sel_param
        }
        responder_choices <- if (length(aval_var) == 0) {
          character(0)
        } else {
          if ("levels" %in% names(sel_param)) {
            if (length(intersect(unique(anl[[aval_var]]), sel_param$levels)) > 1) {
              sel_param$levels
            } else {
              unique(anl[[aval_var]])
            }
          } else {
            unique(anl[[aval_var]])
          }
        }
        updateSelectInput(
          session, "responders",
          choices = responder_choices,
          selected = intersect(responder_choices, common_rsp)
        )
      }
    )

    validate_check <- reactive({
      teal::validate_inputs(iv_r())
      adsl_filtered <- anl_q()[[parentname]]
      anl_filtered <- anl_q()[[dataname]]
      anl <- anl_q()[["ANL"]]

      anl_m <- anl_inputs()
      input_arm_var <- as.vector(anl_m$columns_source$arm_var)
      input_strata_var <- as.vector(anl_m$columns_source$strata_var)
      input_aval_var <- as.vector(anl_m$columns_source$aval_var)
      input_paramcd <- unlist(paramcd$filter)["vars_selected"]

      validate_args <- list(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var, input_strata_var),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_paramcd, input_aval_var),
        arm_var = input_arm_var
      )

      if (length(input_arm_var) > 0 && length(unique(adsl_filtered[[input_arm_var]])) == 1) {
        validate_args <- c(validate_args, list(min_n_levels_armvar = NULL))
      }
      if (isTRUE(input$compare_arms)) {
        validate_args <- c(
          validate_args,
          list(ref_arm = unlist(input$buckets$Ref), comp_arm = unlist(input$buckets$Comp))
        )
      }

      do.call(what = "validate_standard_inputs", validate_args)

      teal::validate_one_row_per_id(anl, key = c("USUBJID", "STUDYID", input_paramcd))

      validate(
        if (length(input_strata_var) >= 1L) {
          need(
            sum(
              vapply(
                anl[input_strata_var],
                FUN = function(x) {
                  length(unique(x)) > 1
                },
                logical(1)
              )
            ) > 0,
            "At least one strata variable must have more than one non-empty level after filtering."
          )
        }
      )

      validate(
        if (length(input_strata_var) >= 1L) {
          need(
            sum(
              vapply(
                anl[input_strata_var],
                FUN = function(strata) {
                  tab <- base::table(strata, anl[[input_arm_var]])
                  tab_logic <- tab != 0L
                  sum(apply(tab_logic, 1, sum) == ncol(tab_logic)) >= 2
                },
                FUN.VALUE = logical(1)
              )
            ) > 0,
            "At least one strata variable must have at least two levels with observation(s) in all of the arms."
          )
        }
      )

      if (is.list(default_responses)) {
        validate(
          need(
            all(
              grepl("\\.rsp|\\.levels", names(unlist(default_responses))) |
                gsub("[0-9]*", "", names(unlist(default_responses))) %in% names(default_responses)
            ),
            "The lists given for each AVAL in default_responses must be named 'rsp' and 'levels'."
          )
        )
      }

      NULL
    })

    table_q <- reactive({
      validate_check()

      qenv <- anl_q()
      anl_m <- anl_inputs()
      anl <- qenv[["ANL"]]

      input_aval_var <- as.vector(anl_m$columns_source$aval_var)
      req(input$responders %in% anl[[input_aval_var]])

      input_strata_var <- as.vector(anl_m$columns_source$strata_var)
      input_paramcd <- unlist(anl_m$filter_info$paramcd)["selected"]

      responder_val_levels <- as.character(unique(anl[[input_aval_var]]))
      final_responder <- if (is.list(default_responses)) {
        default_responses[[input_paramcd]][["levels"]]
      } else {
        responder_val_levels
      }
      if (length(final_responder) == 0) final_responder <- input$responders

      my_calls <- template_binary_outcome(
        dataname = "ANL",
        parentname = "ANL_ADSL",
        arm_var = as.vector(anl_m$columns_source$arm_var),
        paramcd = input_paramcd,
        ref_arm = unlist(input$buckets$Ref),
        comp_arm = unlist(input$buckets$Comp),
        compare_arm = input$compare_arms,
        combine_comp_arms = input$combine_comp_arms && input$compare_arms,
        aval_var = input_aval_var,
        responder_val = input$responders,
        responder_val_levels = final_responder,
        show_rsp_cat = input$show_rsp_cat,
        control = list(
          global = list(
            method = input$prop_ci_method,
            conf_level = as.numeric(input$conf_level)
          ),
          unstrat = list(
            method_ci = input$u_diff_ci,
            method_test = input$u_diff_test,
            odds = input$u_odds_ratio
          ),
          strat = list(
            method_ci = input$s_diff_ci,
            method_test = input$s_diff_test,
            strat = if (length(input_strata_var) != 0) input_strata_var else NULL
          )
        ),
        add_total = input$add_total,
        total_label = total_label,
        na_level = na_level,
        basic_table_args = basic_table_args
      )

      teal.code::eval_code(qenv, as.expression(my_calls))
    })

    # Outputs to render.
    table_r <- reactive(table_q()[["result"]])

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    # Render R code.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive({
        teal.code::get_code(table_q())
      }),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Binary Outcome Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(table_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Line Plot
#'
#' Creates a valid expression to generate a [ggplot2::ggplot()] line plot.
#'
#' @inheritParams tern::g_lineplot
#' @inheritParams tern::control_lineplot_vars
#' @inheritParams template_arguments
#' @param strata (`string` or `NA`)\cr group variable name.
#' @param param (`character`)\cr parameter to filter the data by.
#' @param incl_screen (`logical`)\cr whether the screening visit should be included.
#' @param ggplot2_args (`ggplot2_args`) optional\cr object created by [teal.widgets::ggplot2_args()] with settings
#' for the module plot. For this module, this argument will only accept `ggplot2_args` object with `labs` list of
#' following child elements: `title`, `subtitle`, `caption`, `y`, `lty`. No other elements would be taken into
#' account. The argument is merged with option `teal.ggplot2_args` and with default module arguments (hard coded in
#' the module body).
#'
#' For more details, see the vignette: `vignette("custom-ggplot2-arguments", package = "teal.widgets")`.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_g_lineplot()]
#'
#' @keywords internal
template_g_lineplot <- function(dataname = "ANL",
                                strata = "ARM",
                                x = "AVISIT",
                                y = "AVAL",
                                y_unit = "AVALU",
                                paramcd = "PARAMCD",
                                param = "ALT",
                                mid = "mean",
                                interval = "mean_ci",
                                whiskers = c("mean_ci_lwr", "mean_ci_upr"),
                                table = c("n", "mean_sd", "median", "range"),
                                mid_type = "pl",
                                conf_level = 0.95,
                                incl_screen = TRUE,
                                mid_point_size = 2,
                                table_font_size = 4,
                                title = "Line Plot",
                                y_lab = "",
                                ggplot2_args = teal.widgets::ggplot2_args()) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(strata)
  checkmate::assert_string(x)
  checkmate::assert_string(y)
  checkmate::assert_string(y_unit)
  checkmate::assert_string(paramcd)
  checkmate::assert_string(title)
  checkmate::assert_string(y_lab)

  z <- list()

  data_list <- list()

  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl,
      env = list(anl = as.name(dataname))
    )
  )

  if (!incl_screen) {
    data_list <- add_expr(
      data_list,
      substitute_names(
        expr = dplyr::filter(x_var != "SCREENING") %>%
          dplyr::mutate(x_var = factor(x_var)),
        names = list(x_var = as.name(x))
      )
    )
  }

  # droplevels for strata
  data_list <- add_expr(
    data_list,
    substitute_names(
      expr = dplyr::mutate(
        arm_var = droplevels(arm_var)
      ),
      names = list(
        arm_var = as.name(strata)
      )
    )
  )

  z$data <- substitute(
    expr = {
      anl <- data_pipe
    },
    env = list(
      data_pipe = pipe_expr(data_list)
    )
  )

  z$variables <- substitute(
    expr = variables <- control_lineplot_vars(x = x, y = y, group_var = arm, paramcd = paramcd, y_unit = y_unit),
    env = list(x = x, y = y, arm = strata, paramcd = paramcd, y_unit = y_unit)
  )

  mid_choices <- c(
    "Mean" = "mean",
    "Median" = "median"
  )

  interval_choices <- c(
    "Mean Confidence Interval" = "mean_ci",
    "Median Confidence Interval" = "median_ci",
    "25% and 75% Quantiles" = "quantiles",
    "Range" = "range"
  )

  graph_list <- list()

  graph_list <- add_expr(
    graph_list,
    quote(grid::grid.newpage())
  )

  all_ggplot2_args <- teal.widgets::resolve_ggplot2_args(
    user_plot = ggplot2_args,
    module_plot = teal.widgets::ggplot2_args(
      labs = list(
        title = paste0(
          "Plot of ", names(which(mid_choices == mid)),
          if (!is.null(interval)) {
            paste0(
              " and ",
              if (interval %in% c("mean_ci", "median_ci")) paste0(conf_level * 100, "% "),
              names(which(interval_choices == interval))
            )
          },
          " of ", y, " by Visit"
        ),
        subtitle = "",
        y = sprintf("%s %s Values for", y, names(which(mid_choices == mid)))
      )
    )
  )

  plot_call <- substitute(
    g_lineplot(
      df = anl,
      variables = variables,
      interval = interval,
      mid = mid,
      whiskers = whiskers,
      table = table,
      mid_type = mid_type,
      mid_point_size = mid_point_size,
      table_font_size = table_font_size,
      newpage = FALSE,
      title = ggplot2_args_title,
      subtitle = ggplot2_args_subtitle,
      caption = ggplot2_args_caption,
      y_lab = ggplot2_args_ylab,
      legend_title = ggplot2_args_legend_title,
      ggtheme = ggplot2::theme_minimal(),
      control = control_analyze_vars(conf_level = conf_level),
      subtitle_add_paramcd = FALSE,
      subtitle_add_unit = FALSE
    ),
    env = list(
      conf_level = conf_level,
      interval = interval,
      mid = mid,
      whiskers = whiskers,
      table = table,
      mid_type = mid_type,
      mid_choices = mid_choices,
      interval_choices = interval_choices,
      mid_point_size = mid_point_size,
      table_font_size = table_font_size,
      y = y,
      ggplot2_args_title = all_ggplot2_args$labs$title,
      ggplot2_args_subtitle = all_ggplot2_args$labs$subtitle,
      ggplot2_args_caption = all_ggplot2_args$labs$caption,
      ggplot2_args_ylab = all_ggplot2_args$labs$y,
      ggplot2_args_legend_title = all_ggplot2_args$labs$lty
    )
  )

  graph_list <- add_expr(
    graph_list,
    substitute(
      expr = {
        plot <- plot_call
        plot
      },
      env = list(plot_call = plot_call)
    )
  )

  z$graph <- bracket_expr(graph_list)

  z
}

#' teal Module: Line Plot
#'
#' This module produces a [ggplot2::ggplot()] type line plot, with optional summary table, for standard ADaM data.
#'
#' @inheritParams module_arguments
#' @inheritParams template_g_lineplot
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' library(nestcolor)
#' library(dplyr)
#' library(forcats)
#'
#' ADSL <- tmc_ex_adsl
#' ADLB <- tmc_ex_adlb %>% mutate(AVISIT == fct_reorder(AVISIT, AVISITN, min))
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADLB = ADLB,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADLB <- tmc_ex_adlb %>% mutate(AVISIT == fct_reorder(AVISIT, AVISITN, min))
#'     "
#'   ),
#'   modules = modules(
#'     tm_g_lineplot(
#'       label = "Line Plot",
#'       dataname = "ADLB",
#'       strata = choices_selected(
#'         variable_choices(ADSL, c("ARM", "ARMCD", "ACTARMCD")),
#'         "ARM"
#'       ),
#'       y = choices_selected(
#'         variable_choices(ADLB, c("AVAL", "BASE", "CHG", "PCHG")),
#'         "AVAL"
#'       ),
#'       param = choices_selected(
#'         value_choices(ADLB, "PARAMCD", "PARAM"),
#'         "ALT"
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_g_lineplot <- function(label,
                          dataname,
                          parentname = ifelse(
                            inherits(strata, "data_extract_spec"),
                            teal.transform::datanames_input(strata),
                            "ADSL"
                          ),
                          strata = teal.transform::choices_selected(
                            teal.transform::variable_choices(parentname, c("ARM", "ARMCD", "ACTARMCD")), "ARM"
                          ),
                          x = teal.transform::choices_selected(
                            teal.transform::variable_choices(dataname, "AVISIT"), "AVISIT",
                            fixed = TRUE
                          ),
                          y = teal.transform::choices_selected(
                            teal.transform::variable_choices(dataname, c("AVAL", "BASE", "CHG", "PCHG")), "AVAL"
                          ),
                          y_unit = teal.transform::choices_selected(
                            teal.transform::variable_choices(dataname, "AVALU"), "AVALU",
                            fixed = TRUE
                          ),
                          paramcd = teal.transform::choices_selected(
                            teal.transform::variable_choices(dataname, "PARAMCD"), "PARAMCD",
                            fixed = TRUE
                          ),
                          param = teal.transform::choices_selected(
                            teal.transform::value_choices(dataname, "PARAMCD", "PARAM"), "ALT"
                          ),
                          conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE),
                          interval = "mean_ci",
                          mid = "mean",
                          whiskers = c("mean_ci_lwr", "mean_ci_upr"),
                          table = c("n", "mean_sd", "median", "range"),
                          mid_type = "pl",
                          mid_point_size = c(2, 1, 5),
                          table_font_size = c(4, 2, 6),
                          plot_height = c(1000L, 200L, 4000L),
                          plot_width = NULL,
                          pre_output = NULL,
                          post_output = NULL,
                          ggplot2_args = teal.widgets::ggplot2_args()) {
  message("Initializing tm_g_lineplot")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(mid)
  checkmate::assert_string(interval, null.ok = TRUE)
  whiskers <- match.arg(whiskers)
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(conf_level, "choices_selected")
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(ggplot2_args, "ggplot2_args")

  args <- as.list(environment())
  data_extract_list <- list(
    strata = cs_to_des_select(strata, dataname = parentname),
    param = cs_to_des_filter(param, dataname = dataname),
    x = cs_to_des_select(x, dataname = dataname, multiple = FALSE),
    y = cs_to_des_select(y, dataname = dataname, multiple = FALSE),
    y_unit = cs_to_des_select(y_unit, dataname = dataname),
    paramcd = cs_to_des_select(paramcd, dataname = dataname)
  )

  module(
    label = label,
    server = srv_g_lineplot,
    ui = ui_g_lineplot,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        label = label,
        parentname = parentname,
        plot_height = plot_height,
        plot_width = plot_width,
        ggplot2_args = ggplot2_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_g_lineplot <- function(id, ...) {
  a <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$strata,
    a$paramcd,
    a$x,
    a$param,
    a$y,
    a$y_unit
  )

  ns <- NS(id)
  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(
      verbatimTextOutput(outputId = ns("text")),
      teal.widgets::plot_with_settings_ui(
        id = ns("myplot")
      )
    ),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c("strata", "paramcd", "x", "y", "y_unit", "param")]),
      teal.transform::data_extract_ui(
        id = ns("param"),
        label = "Select Biomarker",
        data_extract_spec = a$param,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("strata"),
        label = "Select Treatment Variable",
        data_extract_spec = a$strata,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("y"),
        label = "Analysis Variable",
        data_extract_spec = a$y,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("x"),
        label = "Time Variable",
        data_extract_spec = a$x,
        is_single_dataset = is_single_dataset_value
      ),
      selectInput(
        ns("mid"),
        "Midpoint Statistic",
        choices = c(
          "Mean" = "mean",
          "Median" = "median"
        ),
        selected = "mean"
      ),
      teal.widgets::optionalSelectInput(
        ns("interval"),
        "Interval",
        choices = c(
          "Mean CI" = "mean_ci",
          "Median CI" = "median_ci",
          "25% and 75%-ile" = "quantiles",
          "Min - Max" = "range"
        ),
        selected = "mean_ci"
      ),
      checkboxInput(
        ns("incl_screen"),
        "Include screening visit",
        value = TRUE
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional plot settings",
          teal.widgets::optionalSelectInput(
            ns("conf_level"),
            "Level of Confidence",
            a$conf_level$choices,
            a$conf_level$selected,
            multiple = FALSE,
            fixed = a$conf_level$fixed
          ),
          teal.widgets::optionalSliderInputValMinMax(
            ns("mid_point_size"),
            "Midpoint symbol size",
            a$mid_point_size,
            ticks = FALSE
          ),
          checkboxGroupInput(
            ns("whiskers"),
            "Whiskers to display",
            choices = c("Upper", "Lower"),
            selected = c("Upper", "Lower")
          ),
          radioButtons(
            ns("mid_type"),
            label = "Plot type",
            choices = c(
              "Point and line" = "pl",
              "Point" = "p",
              "Line" = "l"
            ),
            selected = "pl"
          ),
          teal.transform::data_extract_ui(
            id = ns("y_unit"),
            label = "Analysis Unit Variable",
            data_extract_spec = a$y_unit,
            is_single_dataset = is_single_dataset_value
          ),
          teal.transform::data_extract_ui(
            id = ns("paramcd"),
            label = "Parameter Code Variable",
            data_extract_spec = a$paramcd,
            is_single_dataset = is_single_dataset_value
          )
        )
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional table settings",
          teal.widgets::optionalSliderInputValMinMax(
            ns("table_font_size"),
            "Table Font Size",
            a$table_font_size,
            ticks = FALSE
          ),
          checkboxGroupInput(
            ns("table"),
            label = "Choose the statistics to display in the table",
            choices = c(
              "n" = "n",
              "Mean (SD)" = "mean_sd",
              "Mean CI" = "mean_ci",
              "Median" = "median",
              "Median CI" = "median_ci",
              "25% and 75%-ile" = "quantiles",
              "Min - Max" = "range"
            ),
            selected = a$table,
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_g_lineplot <- function(id,
                           data,
                           reporter,
                           filter_panel_api,
                           dataname,
                           parentname,
                           paramcd,
                           strata,
                           x,
                           y,
                           param,
                           y_unit,
                           label,
                           plot_height,
                           plot_width,
                           ggplot2_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(x = x, y = y, strata = strata, paramcd = paramcd, y_unit = y_unit, param = param),
      datasets = data,
      select_validation_rule = list(
        x = shinyvalidate::sv_required("Please select a time variable"),
        y = shinyvalidate::sv_required("Please select an analysis variable"),
        strata = shinyvalidate::sv_required("Please select a treatment variable")
      ),
      filter_validation_rule = list(
        param = shinyvalidate::sv_required(message = "Please select Biomarker filter.")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level"))
      iv$add_rule(
        "conf_level",
        shinyvalidate::sv_between(
          0, 1,
          message_fmt = "Please choose a confidence level between 0 and 1", inclusive = c(FALSE, FALSE)
        )
      )
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr))
    })

    merged <- list(anl_input_r = anl_inputs, anl_q = anl_q)

    validate_checks <- reactive({
      teal::validate_inputs(iv_r())

      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]

      input_strata <- names(merged$anl_input_r()$columns_source$strata)
      input_x_var <- names(merged$anl_input_r()$columns_source$x)
      input_y <- names(merged$anl_input_r()$columns_source$y)
      input_param <- unlist(param$filter)["vars_selected"]
      input_paramcd <- names(merged$anl_input_r()$columns_source$paramcd)
      input_y_unit <- names(merged$anl_input_r()$columns_source$y_unit)

      # validate inputs
      validate_args <- list(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_strata),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_paramcd, input_x_var, input_y, input_y_unit, input_param),
        arm_var = input_strata
      )

      # validate arm levels
      if (length(input_strata) > 0 && length(unique(adsl_filtered[[input_strata]])) == 1) {
        validate_args <- append(validate_args, list(min_n_levels_armvar = NULL))
      }

      do.call(what = "validate_standard_inputs", validate_args)
      NULL
    })

    all_q <- reactive({
      validate_checks()
      ANL <- merged$anl_q()[["ANL"]]
      teal::validate_has_data(ANL, 2)

      whiskers_selected <- if ("Lower" %in% input$whiskers) 1 else NULL
      if ("Upper" %in% input$whiskers) whiskers_selected <- c(whiskers_selected, 2)
      if (is.null(input$interval) || is.null(whiskers_selected)) {
        input_whiskers <- NULL
        input_interval <- NULL
      } else {
        input_interval <- input$interval
        input_whiskers <- names(tern::s_summary(0)[[input_interval]][whiskers_selected])
      }
      input_param <- as.character(unique(ANL[[names(merged$anl_input_r()$columns_source$param)[1]]]))

      my_calls <- template_g_lineplot(
        dataname = "ANL",
        strata = names(merged$anl_input_r()$columns_source$strata),
        y = names(merged$anl_input_r()$columns_source$y),
        x = names(merged$anl_input_r()$columns_source$x),
        paramcd = names(merged$anl_input_r()$columns_source$paramcd),
        y_unit = names(merged$anl_input_r()$columns_source$y_unit),
        conf_level = as.numeric(input$conf_level),
        incl_screen = input$incl_screen,
        mid = input$mid,
        interval = input_interval,
        whiskers = input_whiskers,
        table = input$table,
        mid_type = input$mid_type,
        mid_point_size = input$mid_point_size,
        table_font_size = input$table_font_size,
        ggplot2_args = ggplot2_args
      )
      teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
    })

    plot_r <- reactive(all_q()[["plot"]])

    # Insert the plot into a plot with settings module from teal.widgets
    pws <- teal.widgets::plot_with_settings_srv(
      id = "myplot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Line Plot",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Plot", "header3")
        card$append_plot(plot_r(), dim = pws$dim())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Univariable Cox Regression
#'
#' Creates a valid expression to generate a univariable Cox regression analysis.
#'
#' @inheritParams template_arguments
#' @param control (`list`)\cr list of settings for the analysis (see [control_coxreg()]).
#' @param at (`list` of `numeric`)\cr when the candidate covariate is a `numeric` type variable, use `at`
#'   to specify the value of the covariate at which the effect should be estimated.
#' @param append (`logical`)\cr whether the result should be appended to the previous one.
#'
#' @inherit template_arguments return
#'
#' @seealso [template_coxreg_m()], [tm_t_coxreg()]
#'
#' @keywords internal
template_coxreg_u <- function(dataname,
                              cov_var,
                              arm_var,
                              cnsr_var,
                              aval_var,
                              ref_arm,
                              comp_arm,
                              paramcd,
                              at = list(),
                              strata_var = NULL,
                              combine_comp_arms = FALSE,
                              control = control_coxreg(),
                              na_level = default_na_str(),
                              append = FALSE,
                              basic_table_args = teal.widgets::basic_table_args()) {
  y <- list()
  ref_arm_val <- paste(ref_arm, collapse = "/")

  data_pipe <- list()
  data_list <- list()

  data_pipe <- add_expr(
    data_pipe,
    prepare_arm(
      dataname = dataname,
      arm_var = arm_var,
      ref_arm = ref_arm,
      comp_arm = comp_arm,
      ref_arm_val = ref_arm_val
    )
  )

  if (combine_comp_arms) {
    data_pipe <- add_expr(
      data_pipe,
      substitute_names(
        expr = dplyr::mutate(arm_var = combine_levels(x = arm_var, levels = comp_arm)),
        names = list(arm_var = as.name(arm_var)),
        others = list(comp_arm = comp_arm)
      )
    )
  }

  data_pipe <- add_expr(
    data_pipe,
    substitute(
      expr = dplyr::mutate(event = 1 - cnsr_var),
      env = list(cnsr_var = as.name(cnsr_var))
    )
  )

  data_pipe <- add_expr(
    data_pipe,
    substitute(
      expr = dplyr::mutate(across(where(is.factor) & cov_var, droplevels)),
      env = list(cov_var = cov_var)
    )
  )

  data_pipe <- add_expr(
    data_pipe,
    substitute(
      expr = df_explicit_na(na_level = na_lvl),
      env = list(na_lvl = na_level)
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl <- data_pipe,
      env = list(data_pipe = pipe_expr(data_pipe))
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = control <- ctrl,
      env = list(ctrl = control)
    )
  )

  variables <- list(time = aval_var, event = "event", arm = arm_var)

  if (!is.null(cov_var)) variables$covariates <- cov_var
  if (!is.null(strata_var)) variables$strata <- strata_var

  y$data <- bracket_expr(data_list)

  layout_list <- list()

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(
        title = paste("Multi-Variable Cox Regression for", paramcd),
        main_footer = c(
          paste("p-value method for Coxph (Hazard Ratio):", control$pval_method),
          paste("Ties for Coxph (Hazard Ratio):", control$ties)
        )
      )
    )
  )

  layout_list <- add_expr(
    layout_list,
    parsed_basic_table_args
  )

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = rtables::append_topleft(paramcd),
      env = list(paramcd = paramcd)
    )
  )

  stats <- c("n", "hr", "ci", "pval")

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = summarize_coxreg(
        variables = variables,
        control = control,
        at = at,
        multivar = multivariate,
        .stats = stats,
        na_str = na_str
      ),
      env = list(
        multivariate = FALSE,
        variables = variables,
        control = control,
        at = at,
        stats = if (control$interaction) c(stats, "pval_inter") else stats,
        na_str = na_level
      )
    )
  )

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  y$table <- if (append) {
    quote(result <- c(result, rtables::build_table(lyt = lyt, df = anl)))
  } else {
    quote(result <- rtables::build_table(lyt = lyt, df = anl))
  }

  y
}

#' Template: Multi-Variable Cox Regression
#'
#' Creates a valid expression to generate a multi-variable Cox regression analysis.
#'
#' @inheritParams template_coxreg_u
#' @inheritParams template_arguments
#'
#' @inherit template_arguments return
#'
#' @seealso [template_coxreg_u()], [tm_t_coxreg()]
#'
#' @keywords internal
template_coxreg_m <- function(dataname,
                              cov_var,
                              arm_var,
                              cnsr_var,
                              aval_var,
                              ref_arm,
                              comp_arm,
                              paramcd,
                              at = list(),
                              strata_var = NULL,
                              combine_comp_arms = FALSE,
                              control = control_coxreg(),
                              na_level = default_na_str(),
                              basic_table_args = teal.widgets::basic_table_args()) {
  y <- list()
  ref_arm_val <- paste(ref_arm, collapse = "/")

  data_pipe <- list()
  data_list <- list()

  data_pipe <- add_expr(
    data_pipe,
    prepare_arm(
      dataname = dataname,
      arm_var = arm_var,
      ref_arm = ref_arm,
      comp_arm = comp_arm,
      ref_arm_val = ref_arm_val
    )
  )

  if (combine_comp_arms) {
    data_pipe <- add_expr(
      data_pipe,
      substitute_names(
        expr = dplyr::mutate(arm_var = combine_levels(x = arm_var, levels = comp_arm)),
        names = list(arm_var = as.name(arm_var)),
        others = list(comp_arm = comp_arm)
      )
    )
  }

  data_pipe <- add_expr(
    data_pipe,
    substitute(
      expr = dplyr::mutate(event = 1 - cnsr_var),
      env = list(cnsr_var = as.name(cnsr_var))
    )
  )

  data_pipe <- add_expr(
    data_pipe,
    substitute(
      expr = dplyr::mutate(across(where(is.factor) & cov_var, droplevels)),
      env = list(cov_var = cov_var)
    )
  )

  data_pipe <- add_expr(
    data_pipe,
    substitute(
      expr = df_explicit_na(na_level = na_lvl),
      env = list(na_lvl = na_level)
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl <- data_pipe,
      env = list(data_pipe = pipe_expr(data_pipe))
    )
  )

  variables <- list(time = aval_var, event = "event", arm = arm_var)

  if (!is.null(cov_var)) variables$covariates <- cov_var
  if (!is.null(strata_var)) variables$strata <- strata_var

  y$data <- bracket_expr(data_list)

  layout_list <- list()

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(
        title = paste("Cox Regression for", paramcd),
        main_footer = c(
          paste("p-value method for Coxph (Hazard Ratio):", control$pval_method),
          paste("Ties for Coxph (Hazard Ratio):", control$ties)
        )
      )
    )
  )

  layout_list <- add_expr(
    layout_list,
    parsed_basic_table_args
  )

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = rtables::append_topleft(paramcd),
      env = list(paramcd = paramcd)
    )
  )

  stats <- c("hr", "ci", "pval")

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = summarize_coxreg(
        variables = variables,
        control = control,
        multivar = multivariate,
        .stats = stats,
        na_str = na_str
      ),
      env = list(
        variables = variables,
        control = control,
        multivariate = TRUE,
        stats = stats,
        na_str = na_level
      )
    )
  )

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  y$table <- quote({
    result <- rtables::build_table(lyt = lyt, df = anl)
    result
  })

  y
}

#' teal Module: Cox Regression Model
#'
#' This module fits Cox univariable or multi-variable models, consistent with the TLG Catalog
#' templates for Cox regression tables `COXT01` and `COXT02`, respectively. See the TLG Catalog entries
#' for `COXT01` [here](https://insightsengineering.github.io/tlg-catalog/stable/tables/efficacy/coxt01.html)
#' and `COXT02` [here](https://insightsengineering.github.io/tlg-catalog/stable/tables/efficacy/coxt02.html).
#'
#' @inheritParams module_arguments
#' @inheritParams template_coxreg_u
#' @inheritParams template_coxreg_m
#' @param multivariate (`logical`)\cr if `FALSE`, the univariable approach is used instead of the
#'   multi-variable model.
#'
#' @details
#' The Cox Proportional Hazards (PH) model is the most commonly used method to
#' estimate the magnitude of the effect in survival analysis. It assumes proportional
#' hazards: the ratio of the hazards between groups (e.g., two arms) is constant over time.
#' This ratio is referred to as the "hazard ratio" (HR) and is one of the most
#' commonly reported metrics to describe the effect size in survival analysis.
#'
#' This modules expects that the analysis data has the following variables:
#'
#' * `AVAL`: time to event
#' * `CNSR`: 1 if record in `AVAL` is censored, 0 otherwise
#' * `PARAMCD`: variable used to filter for endpoint (e.g. OS). After
#'   filtering for `PARAMCD` one observation per patient is expected
#'
#' The arm variables and stratification/covariate variables are taken from the `ADSL` data.
#'
#' @note
#' * The likelihood ratio test is not supported for models that include strata - the Wald
#'   test will be substituted in these cases.
#' * Multi-variable is the default choice for backward compatibility.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' ## First example
#' ## =============
#' ## The example below is based on the usual approach involving creation of
#' ## a random CDISC dataset and then running the application.
#'
#' arm_ref_comp <- list(
#'   ACTARMCD = list(
#'     ref = "ARM B",
#'     comp = c("ARM A", "ARM C")
#'   ),
#'   ARM = list(
#'     ref = "B: Placebo",
#'     comp = c("A: Drug X", "C: Combination")
#'   )
#' )
#'
#' data <- teal_data()
#' data <- within(data, {
#'   ADSL <- tmc_ex_adsl
#'   ADTTE <- tmc_ex_adtte
#' })
#' datanames <- c("ADSL", "ADTTE")
#' datanames(data) <- datanames
#' join_keys(data) <- default_cdisc_join_keys[datanames]
#'
#' app <- init(
#'   data = data,
#'   modules = modules(
#'     tm_t_coxreg(
#'       label = "Cox Reg.",
#'       dataname = "ADTTE",
#'       arm_var = choices_selected(c("ARM", "ARMCD", "ACTARMCD"), "ARM"),
#'       arm_ref_comp = arm_ref_comp,
#'       paramcd = choices_selected(
#'         value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), "OS"
#'       ),
#'       strata_var = choices_selected(
#'         c("COUNTRY", "STRATA1", "STRATA2"), "STRATA1"
#'       ),
#'       cov_var = choices_selected(
#'         c("AGE", "BMRKR1", "BMRKR2", "REGION1"), "AGE"
#'       ),
#'       multivariate = TRUE
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' ## Second example
#' ## ==============
#' ## This time, a synthetic pair of ADTTE/ADSL data is fabricated for Cox regression
#' ## where ties and pval_method matter.
#'
#' ## Dataset fabrication
#' ## -------------------
#'
#' data <- teal_data()
#' data <- within(data, {
#'   library(dplyr)
#'   ADTTE <- data.frame(
#'     STUDYID = "LUNG",
#'     AVAL = c(4, 3, 1, 1, 2, 2, 3, 1, 2),
#'     CNSR = c(1, 1, 1, 0, 1, 1, 0, 0, 0),
#'     ARMCD = factor(
#'       c(0, 1, 1, 1, 1, 0, 0, 0, 0),
#'       labels = c("ARM A", "ARM B")
#'     ),
#'     SEX = factor(
#'       c(0, 0, 0, 0, 1, 1, 1, 1, 1),
#'       labels = c("F", "M")
#'     ),
#'     INST = factor(c("A", "A", "B", "B", "A", "B", "A", "B", "A")),
#'     stringsAsFactors = FALSE
#'   )
#'   ADTTE <- rbind(ADTTE, ADTTE, ADTTE, ADTTE)
#'   ADTTE <- as_tibble(ADTTE)
#'   set.seed(1)
#'   ADTTE$INST <- sample(ADTTE$INST)
#'   ADTTE$AGE <- sample(seq(5, 75, 5), size = nrow(ADTTE), replace = TRUE)
#'   ADTTE$USUBJID <- paste("sub", 1:nrow(ADTTE), ADTTE$INST, sep = "-")
#'   ADTTE$PARAM <- ADTTE$PARAMCD <- "OS"
#'   ADSL <- subset(
#'     ADTTE,
#'     select = c("USUBJID", "STUDYID", "ARMCD", "SEX", "INST", "AGE")
#'   )
#' })
#'
#' datanames <- c("ADSL", "ADTTE")
#' datanames(data) <- datanames
#' join_keys(data) <- default_cdisc_join_keys[datanames]
#'
#' ## `teal` application
#' ## ----------------
#' ## Note that the R code exported by `Show R Code` does not include the data
#' ## pre-processing. You will need to create the dataset as above before
#' ## running the exported R code.
#'
#' arm_ref_comp <- list(ARMCD = list(ref = "ARM A", comp = c("ARM B")))
#' app <- init(
#'   data = data,
#'   modules = modules(
#'     tm_t_coxreg(
#'       label = "Cox Reg.",
#'       dataname = "ADTTE",
#'       arm_var = choices_selected(c("ARMCD"), "ARMCD"),
#'       arm_ref_comp = arm_ref_comp,
#'       paramcd = choices_selected(
#'         value_choices(data[["ADTTE"]], "PARAMCD", "PARAM"), "OS"
#'       ),
#'       strata_var = choices_selected(c("INST"), NULL),
#'       cov_var = choices_selected(c("SEX", "AGE"), "SEX"),
#'       multivariate = TRUE
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_coxreg <- function(label,
                        dataname,
                        parentname = ifelse(
                          inherits(arm_var, "data_extract_spec"),
                          teal.transform::datanames_input(arm_var),
                          "ADSL"
                        ),
                        arm_var,
                        arm_ref_comp = NULL,
                        paramcd,
                        cov_var,
                        strata_var,
                        aval_var = teal.transform::choices_selected(
                          teal.transform::variable_choices(dataname, "AVAL"), "AVAL",
                          fixed = TRUE
                        ),
                        cnsr_var = teal.transform::choices_selected(
                          teal.transform::variable_choices(dataname, "CNSR"), "CNSR",
                          fixed = TRUE
                        ),
                        multivariate = TRUE,
                        na_level = default_na_str(),
                        conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE),
                        pre_output = NULL,
                        post_output = NULL,
                        basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_coxreg")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(na_level)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(cov_var, "choices_selected")
  checkmate::assert_class(strata_var, "choices_selected")
  checkmate::assert_class(aval_var, "choices_selected")
  checkmate::assert_class(cnsr_var, "choices_selected")
  checkmate::assert_class(conf_level, "choices_selected")
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  args <- as.list(environment())

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname, label = NULL),
    strata_var = cs_to_des_select(strata_var, dataname = parentname, multiple = TRUE),
    aval_var = cs_to_des_select(aval_var, dataname = dataname),
    cnsr_var = cs_to_des_select(cnsr_var, dataname = dataname),
    cov_var = cs_to_des_select(cov_var, dataname = parentname, multiple = TRUE, ordered = TRUE)
  )

  module(
    label = label,
    server = srv_t_coxreg,
    ui = ui_t_coxreg,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        arm_ref_comp = arm_ref_comp,
        dataname = dataname,
        parentname = parentname,
        label = label,
        na_level = na_level,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_t_coxreg <- function(id, ...) {
  a <- list(...) # module args
  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$arm_var,
    a$paramcd,
    a$strata_var,
    a$aval_var,
    a$cnsr_var,
    a$cov_var
  )

  ns <- NS(id)

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      radioButtons(
        ns("type"),
        label = tags$label("Type of Regression:", class = "text-primary"),
        choices = c(
          "Separate models for comparison groups with one covariate at a time" = "Univariate",
          "One model with all comparison groups and covariates" = "Multivariate"
        ),
        selected = dplyr::if_else(a$multivariate, "Multivariate", "Univariate")
      ),
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(
        a[c("arm_var", "paramcd", "subgroup_var", "strata_var", "aval_var", "cnsr_var", "cov_var")]
      ),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select Endpoint",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("cnsr_var"),
        label = "Censor Variable",
        data_extract_spec = a$cnsr_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("aval_var"),
        label = "Analysis Variable",
        data_extract_spec = a$aval_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      uiOutput(ns("arms_buckets")),
      conditionalPanel(
        condition = paste0("input['", ns("type"), "'] == 'Multivariate'"),
        checkboxInput(
          ns("combine_comp_arms"),
          "Combine all comparison groups?"
        )
      ),
      teal.transform::data_extract_ui(
        id = ns("cov_var"),
        label = "Covariates",
        data_extract_spec = a$cov_var,
        is_single_dataset = is_single_dataset_value
      ),
      conditionalPanel(
        condition = paste0("input['", ns("type"), "'] == 'Univariate'"),
        checkboxInput(
          ns("interactions"),
          "Interaction terms"
        )
      ),
      uiOutput(ns("interaction_input")),
      teal.transform::data_extract_ui(
        id = ns("strata_var"),
        label = "Stratify by",
        data_extract_spec = a$strata_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional table settings",
          conditionalPanel(
            condition = paste0("input['", ns("strata_var"), "'] != ''"),
            radioButtons(
              ns("pval_method"),
              label = tags$p(
                "p-value method for",
                tags$span(class = "text-primary", "Coxph"),
                "(Hazard Ratio)"
              ),
              choices = c("wald", "likelihood"),
              selected = "wald"
            )
          ),
          radioButtons(
            ns("ties"),
            label = tags$p(
              "Ties for ",
              tags$span(class = "text-primary", "Coxph"),
              " (Hazard Ratio)",
              sep = ""
            ),
            choices = c("exact", "breslow", "efron"),
            selected = "exact"
          ),
          teal.widgets::optionalSelectInput(
            inputId = ns("conf_level"),
            label = tags$p(
              "Confidence level for ",
              tags$span(class = "text-primary", "Coxph"),
              " (Hazard Ratio)",
              sep = ""
            ),
            a$conf_level$choices,
            a$conf_level$selected,
            multiple = FALSE,
            fixed = a$conf_level$fixed
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_t_coxreg <- function(id,
                         data,
                         reporter,
                         filter_panel_api,
                         dataname,
                         parentname,
                         arm_var,
                         paramcd,
                         strata_var,
                         aval_var,
                         cnsr_var,
                         cov_var,
                         arm_ref_comp,
                         label,
                         na_level,
                         basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    # Observer to update reference and comparison arm input options.
    iv_arm_ref <- arm_ref_comp_observer(
      session,
      input,
      output,
      id_arm_var = extract_input("arm_var", parentname),
      data = reactive(data()[[parentname]]),
      arm_ref_comp = arm_ref_comp,
      module = "tm_t_coxreg"
    )

    use_interactions <- reactive({
      input$type == "Univariate" && isTRUE(input$interactions)
    })

    overlap_rule <- function(other_var, var_name) {
      function(value) {
        if (length(intersect(value, selector_list()[[other_var]]()$select)) > 0) {
          sprintf("`%s` and `%s` variables should not overlap", var_name[1], var_name[2])
        }
      }
    }

    select_validation_rule <- list(
      aval_var = shinyvalidate::sv_required("An analysis variable is required"),
      cnsr_var = shinyvalidate::sv_required("A censor variable is required"),
      arm_var = shinyvalidate::compose_rules(
        shinyvalidate::sv_required("A treatment variable is required"),
        overlap_rule("strata_var", c("Treatment", "Strata")),
        overlap_rule("cov_var", c("Treatment", "Covariate"))
      ),
      strata_var = shinyvalidate::compose_rules(
        overlap_rule("arm_var", c("Treatment", "Strata")),
        overlap_rule("cov_var", c("Covariate", "Strata"))
      ),
      cov_var = shinyvalidate::compose_rules(
        overlap_rule("arm_var", c("Treatment", "Covariate")),
        overlap_rule("strata_var", c("Covariate", "Strata")),
        ~ if (use_interactions() && length(.) == 0) {
          "If interactions are selected at least one covariate should be specified."
        }
      )
    )

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        arm_var = arm_var,
        paramcd = paramcd,
        strata_var = strata_var,
        aval_var = aval_var,
        cnsr_var = cnsr_var,
        cov_var = cov_var
      ),
      datasets = data,
      select_validation_rule = select_validation_rule,
      filter_validation_rule = list(
        paramcd = shinyvalidate::sv_required("An endpoint is required")
      )
    )


    numeric_level_validation <- function(val) {
      # need to explicitly evaluate 'val' here to ensure
      # the correct label is shown - if this is not done
      # then the last value of "val" is the label for all cases
      v <- val
      ~ if (anyNA(as_numeric_from_comma_sep_str(.))) {
        paste("Numeric interaction level(s) should be specified for", v)
      }
    }


    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_validator(iv_arm_ref)
      iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level"))
      iv$add_rule(
        "conf_level",
        shinyvalidate::sv_between(0, 1, message_fmt = "Confidence level must be between 0 and 1")
      )
      iv$add_rule("pval_method", ~ if (length(selector_list()$strata_var()$select) > 0 && . != "wald") {
        "Only Wald tests are supported for models with strata."
      })
      # add rules for interaction_var text inputs

      for (val in interaction_var_r()) {
        iv$add_rule(
          paste0("interact_", val),
          shinyvalidate::sv_required(paste("Interaction level(s) should be specified for", val))
        )
        iv$add_rule(
          paste0("interact_", val), numeric_level_validation(val)
        )
      }
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      anl_q = anl_q
    )

    ## render conditional strata levels input UI  ----
    open_textinput <- function(x, dataset) {
      # For every numeric covariate, the numeric level for the Hazard Ration
      # estimation is proposed only if the covariate is included in the model:
      # for this purpose, a function and a UI-rendered output.
      textInput(
        session$ns(paste0("interact_", x)),
        label = paste("Hazard Ratios for", x, "at (comma delimited):"),
        value = as.character(stats::median(dataset[[x]]))
      )
    }

    interaction_var_r <- reactive({
      # exclude cases when increments are not necessary and
      # finally accessing the UI-rendering function defined above.
      if (use_interactions()) {
        input_cov_var <- as.vector(merged$anl_input_r()$columns_source$cov_var)
        dataset <- merged$anl_q()[[dataname]]
        cov_is_numeric <- vapply(dataset[input_cov_var], is.numeric, logical(1))
        input_cov_var[cov_is_numeric]
      } else {
        NULL
      }
    })

    output$interaction_input <- renderUI({
      if (length(interaction_var_r()) > 0) {
        lapply(interaction_var_r(), open_textinput, dataset = merged$anl_q()[[dataname]])
      }
    })

    ## Prepare the call evaluation environment ----
    validate_checks <- reactive({
      teal::validate_inputs(iv_r())

      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]

      input_arm_var <- as.vector(merged$anl_input_r()$columns_source$arm_var)
      input_strata_var <- as.vector(merged$anl_input_r()$columns_source$strata_var)
      input_aval_var <- as.vector(merged$anl_input_r()$columns_source$aval_var)
      input_cnsr_var <- as.vector(merged$anl_input_r()$columns_source$cnsr_var)
      input_paramcd <- unlist(paramcd$filter)["vars_selected"]
      input_cov_var <- as.vector(merged$anl_input_r()$columns_source$cov_var)

      cov_is_numeric <- vapply(anl_filtered[input_cov_var], is.numeric, logical(1))
      interaction_var <- input_cov_var[cov_is_numeric]

      # validate inputs
      validate_args <- list(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var, input_strata_var),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_paramcd, input_aval_var, input_cnsr_var),
        arm_var = input_arm_var,
        ref_arm = unlist(input$buckets$Ref),
        comp_arm = unlist(input$buckets$Comp),
        min_nrow = 4
      )

      #  validate arm levels
      if (length(input_arm_var) > 0 && length(unique(adsl_filtered[[input_arm_var]])) == 1) {
        validate_args <- append(validate_args, list(min_n_levels_armvar = NULL))
      }

      do.call(what = "validate_standard_inputs", validate_args)

      arm_n <- base::table(anl_filtered[[input_arm_var]])
      anl_arm_n <- if (input$combine_comp_arms) {
        c(sum(arm_n[unlist(input$buckets$Ref)]), sum(arm_n[unlist(input$buckets$Comp)]))
      } else {
        c(sum(arm_n[unlist(input$buckets$Ref)]), arm_n[unlist(input$buckets$Comp)])
      }
      validate(shiny::need(
        all(anl_arm_n >= 2),
        "Each treatment group should have at least 2 records."
      ))

      # validate covariate has at least two levels
      validate(
        need(
          all(vapply(anl_filtered[input_cov_var], FUN = function(x) {
            length(unique(x)) > 1
          }, logical(1))),
          "All covariates needs to have at least two levels"
        )
      )

      NULL
    })

    at <- reactive({
      input_cov_var <- as.vector(merged$anl_input_r()$columns_source$cov_var)
      cov_is_numeric <- vapply(merged$anl_q()[[dataname]][input_cov_var], is.numeric, logical(1))
      interaction_var <- input_cov_var[cov_is_numeric]
      if (length(interaction_var) > 0 && length(input_cov_var) > 0) {
        res <- lapply(
          interaction_var,
          function(x) {
            cov <- input[[paste0("interact_", x)]]
            if (!is.null(cov)) {
              as_numeric_from_comma_sep_str(cov)
            }
          }
        )
        stats::setNames(res, interaction_var)
      }
    })


    call_template <- function(comp_arm, anl, paramcd, multivariate, basic_table_args = NULL) {
      strata_var <- as.vector(anl$columns_source$strata_var)
      strata_var <- if (length(strata_var) != 0) strata_var else NULL
      cov_var <- as.vector(anl$columns_source$cov_var)
      cov_var <- if (length(cov_var) > 0) cov_var else NULL

      at <- if (use_interactions()) at() else list()
      arm_var <- as.vector(anl$columns_source$arm_var)
      cnsr_var <- as.vector(anl$columns_source$cnsr_var)
      aval_var <- as.vector(anl$columns_source$aval_var)
      ref_arm <- unlist(input$buckets$Ref)
      combine_comp_arms <- input$combine_comp_arms
      control <- control_coxreg(
        pval_method = input$pval_method,
        ties = input$ties,
        conf_level = as.numeric(input$conf_level),
        interaction = `if`(!use_interactions(), FALSE, input$interactions)
      )

      if (multivariate) {
        template_coxreg_m(
          dataname = "ANL",
          cov_var = cov_var,
          at = at,
          arm_var = arm_var,
          cnsr_var = cnsr_var,
          aval_var = aval_var,
          ref_arm = ref_arm,
          comp_arm = comp_arm,
          paramcd = paramcd,
          strata_var = strata_var,
          combine_comp_arms = combine_comp_arms,
          control = control,
          na_level = na_level,
          basic_table_args = basic_table_args
        )
      } else {
        template_coxreg_u(
          dataname = "ANL",
          cov_var = cov_var,
          at = at,
          arm_var = arm_var,
          cnsr_var = cnsr_var,
          aval_var = aval_var,
          ref_arm = ref_arm,
          comp_arm = comp_arm,
          paramcd = paramcd,
          strata_var = strata_var,
          combine_comp_arms = combine_comp_arms,
          control = control,
          na_level = na_level,
          append = TRUE,
          basic_table_args = basic_table_args
        )
      }
    }

    ## generate table call with template and render table ----
    all_q <- reactive({
      validate_checks()

      ANL <- merged$anl_q()[["ANL"]]
      paramcd <- as.character(unique(ANL[[unlist(paramcd$filter)["vars_selected"]]]))
      multivariate <- input$type == "Multivariate"
      strata_var <- as.vector(merged$anl_input_r()$columns_source$strata_var)

      if (input$type == "Multivariate") {
        main_title <- paste("Multi-Variable Cox Regression for", paramcd)
        subtitle <- ifelse(length(strata_var) == 0, "", paste("Stratified by", paste(strata_var, collapse = " and ")))
        all_basic_table_args <- teal.widgets::resolve_basic_table_args(
          user_table = basic_table_args,
          module_table = teal.widgets::basic_table_args(
            title = main_title,
            subtitles = subtitle
          )
        )
        expr <- call_template(
          unlist(input$buckets$Comp), merged$anl_input_r(),
          paramcd, multivariate, all_basic_table_args
        )
        teal.code::eval_code(merged$anl_q(), as.expression(expr))
      } else {
        main_title <- paste("Cox Regression for", paramcd)
        subtitle <- ifelse(length(strata_var) == 0, "", paste("Stratified by", paste(strata_var, collapse = " and ")))
        all_basic_table_args <- teal.widgets::resolve_basic_table_args(
          user_table = basic_table_args,
          module_table = teal.widgets::basic_table_args(
            title = main_title,
            subtitles = subtitle
          )
        )

        merged$anl_q() %>%
          teal.code::eval_code(quote(result <- list())) %>%
          teal.code::eval_code(
            as.expression(unlist(lapply(
              unlist(input$buckets$Comp),
              function(x) {
                call_template(x, merged$anl_input_r(), paramcd, multivariate, all_basic_table_args)
              }
            )))
          ) %>%
          teal.code::eval_code(
            substitute(
              expr = {
                result <- lapply(result, function(x) {
                  rtables::col_info(x) <- rtables::col_info(result[[1]])
                  x
                })
                result <- rtables::rbindl_rtables(result, check_headers = TRUE)
                rtables::main_title(result) <- title
                rtables::main_footer(result) <- c(
                  paste("p-value method for Coxph (Hazard Ratio):", control$pval_method),
                  paste("Ties for Coxph (Hazard Ratio):", control$ties)
                )
                rtables::prov_footer(result) <- p_footer
                rtables::subtitles(result) <- subtitle
                result
              },
              env = list(
                title = all_basic_table_args$title,
                p_footer = `if`(is.null(all_basic_table_args$prov_footer), "", all_basic_table_args$prov_footer),
                subtitle = `if`(is.null(all_basic_table_args$subtitles), "", all_basic_table_args$subtitles)
              )
            )
          )
      }
    })

    table_r <- reactive(all_q()[["result"]])

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = "R Code for the Current (Multi-Variable) Cox proportional hazard regression model"
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Cox Regression Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Events by Term
#'
#' Creates a valid expression to generate a table of events by term.
#'
#' @inheritParams template_arguments
#' @param sort_freq_col (`character`)\cr column to sort by frequency on if `sort_criteria` is set to `freq_desc`.
#' @param incl_overall_sum (`flag`)\cr  whether two rows which summarize the overall number of adverse events
#'   should be included at the top of the table.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_events()]
#'
#' @keywords internal
template_events <- function(dataname,
                            parentname,
                            arm_var,
                            hlt,
                            llt,
                            label_hlt = NULL,
                            label_llt = NULL,
                            add_total = TRUE,
                            total_label = default_total_label(),
                            na_level = default_na_str(),
                            event_type = "event",
                            sort_criteria = c("freq_desc", "alpha"),
                            sort_freq_col = total_label,
                            prune_freq = 0,
                            prune_diff = 0,
                            drop_arm_levels = TRUE,
                            incl_overall_sum = TRUE,
                            basic_table_args = teal.widgets::basic_table_args()) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_character(arm_var, min.len = 1, max.len = 2)
  checkmate::assert_string(hlt, null.ok = TRUE)
  checkmate::assert_string(llt, null.ok = TRUE)
  checkmate::assert_string(label_hlt, null.ok = TRUE)
  checkmate::assert_string(label_llt, null.ok = TRUE)
  checkmate::assert_character(c(llt, hlt))
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_string(na_level)
  checkmate::assert_string(event_type)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_scalar(prune_freq)
  checkmate::assert_scalar(prune_diff)

  sort_criteria <- match.arg(sort_criteria)

  y <- list()

  # Start data steps.
  data_list <- list()

  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl <- df,
      env = list(df = as.name(dataname))
    )
  )

  data_list <- add_expr(
    data_list,
    prepare_arm_levels(
      dataname = "anl",
      parentname = parentname,
      arm_var = arm_var[[1]],
      drop_arm_levels = drop_arm_levels
    )
  )
  if (length(arm_var) == 2) {
    data_list <- add_expr(
      data_list,
      prepare_arm_levels(
        dataname = "anl",
        parentname = parentname,
        arm_var = arm_var[[2]],
        drop_arm_levels = drop_arm_levels
      )
    )
  }

  data_list <- add_expr(
    data_list,
    substitute(
      expr = parentname <- df_explicit_na(parentname, na_level = na_lvl),
      env = list(parentname = as.name(parentname), na_lvl = na_level)
    )
  )

  if (sort_criteria == "alpha") {
    if (!is.null(hlt)) {
      data_list <- add_expr(
        data_list,
        substitute(
          expr = anl[[hlt]] <- as.character(anl[[hlt]]),
          env = list(hlt = hlt)
        )
      )
    }

    if (!is.null(llt)) {
      data_list <- add_expr(
        data_list,
        substitute(
          expr = anl[[llt]] <- as.character(anl[[llt]]),
          env = list(llt = llt)
        )
      )
    }
  }

  term_vars <- c(hlt, llt)

  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl <- anl %>%
        df_explicit_na(omit_columns = setdiff(names(anl), term_vars)),
      env = list(
        term_vars = term_vars
      )
    )
  )
  y$data <- bracket_expr(data_list)

  # Start layout steps.
  layout_list <- list()

  basic_title <- if (is.null(hlt) && !is.null(llt)) {
    paste0("Event Summary by Term : ", label_llt)
  } else if (!is.null(hlt) && is.null(llt)) {
    paste0("Event Summary by Term : ", label_hlt)
  } else if (!is.null(hlt) && !is.null(llt)) {
    paste0("Event Summary by Term : ", label_hlt, " and ", label_llt)
  } else {
    "Event Summary by Term"
  }

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(show_colcounts = TRUE, title = basic_title)
    )
  )

  layout_list <- add_expr(layout_list, parsed_basic_table_args)
  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = rtables::split_cols_by(var = arm_var),
      env = list(arm_var = arm_var[[1]])
    )
  )
  if (length(arm_var) == 2) {
    layout_list <- add_expr(
      layout_list,
      if (drop_arm_levels) {
        substitute(
          expr = rtables::split_cols_by(nested_col, split_fun = drop_split_levels),
          env = list(nested_col = arm_var[[2]])
        )
      } else {
        substitute(
          expr = rtables::split_cols_by(nested_col),
          env = list(nested_col = arm_var[[2]])
        )
      }
    )
  }

  if (add_total) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = rtables::add_overall_col(label = total_label),
        env = list(total_label = total_label)
      )
    )
  }

  unique_label <- paste0("Total number of patients with at least one ", event_type)
  nonunique_label <- paste0("Overall total number of ", event_type, "s")

  if (incl_overall_sum) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        summarize_num_patients(
          var = "USUBJID",
          .stats = c("unique", "nonunique"),
          .labels = c(
            unique = unique_label,
            nonunique = nonunique_label
          ),
          na_str = na_str
        ),
        env = list(unique_label = unique_label, nonunique_label = nonunique_label, na_str = na_level)
      )
    )
  }


  one_term <- is.null(hlt) || is.null(llt)

  if (one_term) {
    term_var <- ifelse(is.null(hlt), llt, hlt)

    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = count_occurrences(vars = term_var, .indent_mods = -1L) %>%
          append_varlabels(dataname, term_var),
        env = list(
          term_var = term_var,
          dataname = as.name(dataname)
        )
      )
    )
  } else {
    # Case when both hlt and llt are used.

    y$layout_prep <- quote(split_fun <- drop_split_levels)

    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = rtables::split_rows_by(
          hlt,
          child_labels = "visible",
          nested = FALSE,
          indent_mod = -1L,
          split_fun = split_fun,
          label_pos = "topleft",
          split_label = teal.data::col_labels(dataname[hlt])
        ) %>%
          summarize_num_patients(
            var = "USUBJID",
            .stats = c("unique", "nonunique"),
            .labels = c(
              unique = unique_label,
              nonunique = nonunique_label
            ),
            na_str = na_str
          ) %>%
          count_occurrences(vars = llt, .indent_mods = c(count_fraction = 1L)) %>%
          append_varlabels(dataname, llt, indent = 1L),
        env = list(
          dataname = as.name(dataname),
          hlt = hlt,
          llt = llt,
          unique_label = unique_label,
          nonunique_label = nonunique_label,
          na_str = na_level
        )
      )
    )
  }

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  # Full table.
  y$table <- substitute(
    expr = result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent),
    env = list(parent = as.name(parentname))
  )

  # Start pruning table.
  prune_list <- list()
  prune_list <- add_expr(
    prune_list,
    quote(
      pruned_result <- result %>% rtables::prune_table()
    )
  )

  if (prune_freq > 0 || prune_diff > 0) {
    # Do not use "All Patients" column for pruning conditions.
    prune_list <- add_expr(
      prune_list,
      substitute(
        expr = col_indices <- 1:(ncol(result) - add_total),
        env = list(add_total = add_total)
      )
    )

    if (prune_freq > 0 && prune_diff == 0) {
      prune_list <- add_expr(
        prune_list,
        substitute(
          expr = row_condition <- has_fraction_in_any_col(atleast = prune_freq, col_indices = col_indices),
          env = list(prune_freq = prune_freq)
        )
      )
    } else if (prune_freq == 0 && prune_diff > 0) {
      prune_list <- add_expr(
        prune_list,
        substitute(
          expr = row_condition <- has_fractions_difference(atleast = prune_diff, col_indices = col_indices),
          env = list(prune_diff = prune_diff)
        )
      )
    } else if (prune_freq > 0 && prune_diff > 0) {
      prune_list <- add_expr(
        prune_list,
        substitute(
          expr = row_condition <- has_fraction_in_any_col(atleast = prune_freq, col_indices = col_indices) &
            has_fractions_difference(atleast = prune_diff, col_indices = col_indices),
          env = list(prune_freq = prune_freq, prune_diff = prune_diff)
        )
      )
    }

    # Apply pruning conditions.
    prune_list <- add_expr(
      prune_list,
      substitute(
        expr = pruned_result <- pruned_result %>% rtables::prune_table(keep_rows(row_condition))
      )
    )
  }

  y$prune <- bracket_expr(prune_list)

  # Start sorting pruned table.
  sort_list <- list()

  if (sort_criteria == "alpha") {
    if (prune_freq == 0 && prune_diff == 0) {
      # This is just a dummy step to get the right variable result.
      # No additional sorting is needed because during the data pre-processing step,
      # llt and/or hlt are converted to factors with alphabetically sorted levels.
      # So the order in y$table table is already alphabetically sorted.
      sort_list <- add_expr(
        sort_list,
        quote({
          pruned_and_sorted_result <- pruned_result
          pruned_and_sorted_result
        })
      )
    } else {
      sort_list <- add_expr(
        sort_list,
        quote(
          criteria_fun <- function(tr) {
            inherits(tr, "ContentRow")
          }
        )
      )

      sort_list <- add_expr(
        sort_list,
        quote({
          pruned_and_sorted_result <- rtables::trim_rows(pruned_result, criteria = criteria_fun)
          pruned_and_sorted_result
        })
      )
    }
  } else {
    # Sort by decreasing frequency.
    sort_list <- add_expr(
      sort_list,
      substitute(
        expr = idx_split_col <- which(sapply(col_paths(result), tail, 1) == sort_freq_col),
        env = list(sort_freq_col = sort_freq_col)
      )
    )

    # When the "All Patients" column is present we only use that for scoring.
    scorefun_hlt <- if (add_total) {
      quote(cont_n_onecol(idx_split_col))
    } else {
      quote(cont_n_allcols)
    }
    scorefun_llt <- if (add_total) {
      quote(score_occurrences_cols(col_indices = seq(1, ncol(result))))
    } else {
      quote(score_occurrences)
    }

    if (one_term) {
      term_var <- ifelse(is.null(hlt), llt, hlt)

      sort_list <- add_expr(
        sort_list,
        substitute(
          expr = {
            pruned_and_sorted_result <- pruned_result %>%
              sort_at_path(path = c(term_var), scorefun = scorefun_llt)
            pruned_and_sorted_result
          },
          env = list(
            term_var = term_var,
            scorefun_llt = scorefun_llt
          )
        )
      )
    } else {
      sort_list <- add_expr(
        sort_list,
        substitute(
          expr = {
            pruned_and_sorted_result <- pruned_result %>%
              sort_at_path(path = c(hlt), scorefun = scorefun_hlt) %>%
              sort_at_path(path = c(hlt, "*", llt), scorefun = scorefun_llt)
          },
          env = list(
            llt = llt,
            hlt = hlt,
            scorefun_hlt = scorefun_hlt,
            scorefun_llt = scorefun_llt
          )
        )
      )

      if (prune_freq > 0 || prune_diff > 0) {
        sort_list <- add_expr(
          sort_list,
          quote(
            criteria_fun <- function(tr) {
              inherits(tr, "ContentRow")
            }
          )
        )

        sort_list <- add_expr(
          sort_list,
          quote(
            pruned_and_sorted_result <- rtables::trim_rows(pruned_and_sorted_result, criteria = criteria_fun)
          )
        )
      }

      sort_list <- add_expr(
        sort_list,
        quote(pruned_and_sorted_result)
      )
    }
  }
  y$sort <- bracket_expr(sort_list)

  y
}

#' teal Module: Events by Term
#'
#' This module produces a table of events by term.
#'
#' @inheritParams module_arguments
#' @inheritParams template_events
#' @param arm_var ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for variable names that can be used as `arm_var`.
#'   It defines the grouping variable(s) in the results table.
#'   If there are two elements selected for `arm_var`,
#'   second variable will be nested under the first variable.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' ADSL <- tmc_ex_adsl
#' ADAE <- tmc_ex_adae
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADAE = ADAE,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADAE <- tmc_ex_adae
#'     "
#'   ),
#'   modules = modules(
#'     tm_t_events(
#'       label = "Adverse Event Table",
#'       dataname = "ADAE",
#'       arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"),
#'       llt = choices_selected(
#'         choices = variable_choices(ADAE, c("AETERM", "AEDECOD")),
#'         selected = c("AEDECOD")
#'       ),
#'       hlt = choices_selected(
#'         choices = variable_choices(ADAE, c("AEBODSYS", "AESOC")),
#'         selected = "AEBODSYS"
#'       ),
#'       add_total = TRUE,
#'       event_type = "adverse event"
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_events <- function(label,
                        dataname,
                        parentname = ifelse(
                          inherits(arm_var, "data_extract_spec"),
                          teal.transform::datanames_input(arm_var),
                          "ADSL"
                        ),
                        arm_var,
                        hlt,
                        llt,
                        add_total = TRUE,
                        total_label = default_total_label(),
                        na_level = default_na_str(),
                        event_type = "event",
                        sort_criteria = c("freq_desc", "alpha"),
                        sort_freq_col = total_label,
                        prune_freq = 0,
                        prune_diff = 0,
                        drop_arm_levels = TRUE,
                        incl_overall_sum = TRUE,
                        pre_output = NULL,
                        post_output = NULL,
                        basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_events")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(hlt, "choices_selected")
  checkmate::assert_class(llt, "choices_selected")
  checkmate::assert_string(event_type)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_string(na_level)
  checkmate::assert_string(sort_freq_col)
  checkmate::assert_scalar(prune_freq)
  checkmate::assert_scalar(prune_diff)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_flag(incl_overall_sum)
  sort_criteria <- match.arg(sort_criteria)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  args <- as.list(environment())

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname, multiple = TRUE, ordered = TRUE),
    hlt = cs_to_des_select(hlt, dataname = dataname),
    llt = cs_to_des_select(llt, dataname = dataname)
  )

  module(
    label = label,
    ui = ui_t_events_byterm,
    server = srv_t_events_byterm,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        event_type = event_type,
        label = label,
        total_label = total_label,
        na_level = na_level,
        sort_freq_col = sort_freq_col,
        incl_overall_sum = incl_overall_sum,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_t_events_byterm <- function(id, ...) {
  ns <- NS(id)
  a <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(a$arm_var, a$hlt, a$llt)

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(
      teal.widgets::table_with_settings_ui(ns("table"))
    ),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c("arm_var", "hlt", "llt")]),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("hlt"),
        label = "Event High Level Term",
        data_extract_spec = a$hlt,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("llt"),
        label = "Event Low Level Term",
        data_extract_spec = a$llt,
        is_single_dataset = is_single_dataset_value
      ),
      checkboxInput(ns("add_total"), "Add All Patients columns", value = a$add_total),
      teal.widgets::panel_item(
        "Additional table settings",
        checkboxInput(
          ns("drop_arm_levels"),
          label = "Drop columns not in filtered analysis dataset",
          value = a$drop_arm_levels
        ),
        selectInput(
          inputId = ns("sort_criteria"),
          label = "Sort Criteria",
          choices = c(
            "Decreasing frequency" = "freq_desc",
            "Alphabetically" = "alpha"
          ),
          selected = a$sort_criteria,
          multiple = FALSE
        ),
        helpText(tags$strong("Pruning Options:")),
        numericInput(
          inputId = ns("prune_freq"),
          label = "Minimum Incidence Rate(%) in any of the treatment groups",
          value = a$prune_freq,
          min = 0,
          max = 100,
          step = 1,
          width = "100%"
        ),
        numericInput(
          inputId = ns("prune_diff"),
          label = "Minimum Difference Rate(%) between any of the treatment groups",
          value = a$prune_diff,
          min = 0,
          max = 100,
          step = 1,
          width = "100%"
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_t_events_byterm <- function(id,
                                data,
                                filter_panel_api,
                                reporter,
                                dataname,
                                parentname,
                                event_type,
                                arm_var,
                                hlt,
                                llt,
                                drop_arm_levels,
                                incl_overall_sum,
                                label,
                                total_label,
                                na_level,
                                sort_freq_col,
                                basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(arm_var = arm_var, hlt = hlt, llt = llt),
      datasets = data,
      select_validation_rule = list(
        arm_var = ~ if (length(.) != 1 && length(.) != 2) {
          "Please select 1 or 2 treatment variable values"
        },
        hlt = ~ if (length(selector_list()$llt()$select) + length(.) == 0) {
          "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables."
        },
        llt = ~ if (length(selector_list()$hlt()$select) + length(.) == 0) {
          "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables."
        }
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("prune_freq", shinyvalidate::sv_required("Please provide an Incidence Rate between 0 and 100 (%)."))
      iv$add_rule(
        "prune_freq",
        shinyvalidate::sv_between(0, 100, message_fmt = "Please provide an Incidence Rate between 0 and 100 (%).")
      )
      iv$add_rule("prune_diff", shinyvalidate::sv_required("Please provide a Difference Rate between 0 and 100 (%)."))
      iv$add_rule(
        "prune_diff",
        shinyvalidate::sv_between(0, 100, message_fmt = "Please provide a Difference Rate between 0 and 100 (%).")
      )
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    validate_checks <- reactive({
      teal::validate_inputs(iv_r())

      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]

      input_arm_var <- as.vector(merged$anl_input_r()$columns_source$arm_var)
      input_level_term <- c(
        as.vector(merged$anl_input_r()$columns_source$hlt),
        as.vector(merged$anl_input_r()$columns_source$llt)
      )

      validate(
        if (length(input_arm_var) >= 1) {
          need(is.factor(adsl_filtered[[input_arm_var[[1]]]]), "Treatment variable is not a factor.")
        },
        if (length(input_arm_var) == 2) {
          need(
            is.factor(adsl_filtered[[input_arm_var[[2]]]]) & all(!adsl_filtered[[input_arm_var[[2]]]] %in% c(
              "", NA
            )),
            "Please check nested treatment variable which needs to be a factor without NA or empty strings."
          )
        }
      )

      # validate inputs
      validate_standard_inputs(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_level_term),
        arm_var = input_arm_var[[1]]
      )
    })

    # The R-code corresponding to the analysis.
    table_q <- reactive({
      validate_checks()
      ANL <- merged$anl_q()[["ANL"]]

      input_hlt <- as.vector(merged$anl_input_r()$columns_source$hlt)
      input_llt <- as.vector(merged$anl_input_r()$columns_source$llt)
      label_hlt <- if (length(input_hlt) != 0) attributes(ANL[[input_hlt]])$label else NULL
      label_llt <- if (length(input_llt) != 0) attributes(ANL[[input_llt]])$label else NULL

      my_calls <- template_events(
        dataname = "ANL",
        parentname = "ANL_ADSL",
        arm_var = as.vector(merged$anl_input_r()$columns_source$arm_var),
        hlt = if (length(input_hlt) != 0) input_hlt else NULL,
        llt = if (length(input_llt) != 0) input_llt else NULL,
        label_hlt = label_hlt,
        label_llt = label_llt,
        add_total = input$add_total,
        total_label = total_label,
        na_level = na_level,
        event_type = event_type,
        sort_criteria = input$sort_criteria,
        sort_freq_col = sort_freq_col,
        prune_freq = input$prune_freq / 100,
        prune_diff = input$prune_diff / 100,
        drop_arm_levels = input$drop_arm_levels,
        incl_overall_sum = incl_overall_sum,
        basic_table_args = basic_table_args
      )

      teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
    })

    # Outputs to render.
    table_r <- reactive({
      table_q()[["pruned_and_sorted_result"]]
    })

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    # Render R code.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(table_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Events by Term Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(table_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Patient Profile Vitals Plot
#'
#' Creates a valid expression to generate a patient profile vitals [ggplot2::ggplot()] plot using ADaM datasets.
#'
#' @inheritParams template_arguments
#' @param paramcd_levels (`character`)\cr vector of all levels of `paramcd`.
#' @param xaxis (`character`)\cr name of the time variable to put on the x-axis.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_g_pp_vitals()]
#'
#' @keywords internal
template_vitals <- function(dataname = "ANL",
                            paramcd = "PARAMCD",
                            paramcd_levels = c("SYSBP", "DIABP", "PUL", "RESP", "OXYSAT", "WGHT", "TEMP"),
                            xaxis = "ADY",
                            aval = lifecycle::deprecated(),
                            aval_var = "AVAL",
                            patient_id,
                            font_size = 12L,
                            ggplot2_args = teal.widgets::ggplot2_args()) {
  if (lifecycle::is_present(aval)) {
    aval_var <- aval
    warning(
      "The `aval` argument of `template_vitals()` is deprecated as of teal.modules.clinical 0.8.16. ",
      "Please use the `aval_var` argument instead.",
      call. = FALSE
    )
  }

  checkmate::assert_string(dataname)
  checkmate::assert_string(paramcd)
  checkmate::assert_string(xaxis)
  checkmate::assert_string(aval_var)
  checkmate::assert_string(patient_id)
  checkmate::assert_number(font_size)

  # Note: VSDY (study day of vital signs) was replaced with ADY (analysis day)
  y <- list()
  y$plot <- list()

  parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args(
    teal.widgets::resolve_ggplot2_args(
      user_plot = ggplot2_args,
      module_plot = teal.widgets::ggplot2_args(
        labs = list(title = paste0("Patient ID: ", patient_id)),
        theme = list(
          text = substitute(ggplot2::element_text(size = font), list(font = font_size)),
          axis.text.y = quote(ggplot2::element_blank()),
          axis.ticks.y = quote(ggplot2::element_blank()),
          plot.title = substitute(ggplot2::element_text(size = font), list(font = font_size)),
          legend.position = "top",
          panel.grid.minor = quote(ggplot2::element_line(
            linewidth = 0.5,
            linetype = "dotted",
            colour = "grey"
          )),
          panel.grid.major = quote(ggplot2::element_line(
            linewidth = 0.5,
            linetype = "dotted",
            colour = "grey"
          ))
        )
      )
    ),
    ggtheme = "minimal"
  )

  vital_plot <- add_expr(
    list(),
    substitute_names(
      names = list(
        dataname = as.name(dataname),
        paramcd = as.name(paramcd),
        xaxis = as.name(xaxis),
        aval_var = as.name(aval_var)
      ),
      others = list(paramcd_levels = paramcd_levels),
      expr = {
        vitals <-
          dataname %>%
          dplyr::group_by(paramcd, xaxis) %>%
          dplyr::filter(paramcd %in% paramcd_levels) %>%
          dplyr::summarise(aval_var = max(aval_var, na.rm = TRUE)) %>%
          dplyr::mutate(
            aval_var = ifelse(is.infinite(aval_var), NA, aval_var),
            xaxis = as.numeric(xaxis) # difftime fails ggplot2::scale_x_continuous
          )
      }
    )
  )

  vital_plot <- add_expr(
    vital_plot,
    substitute(
      expr = {
        max_day <- max(vitals[[xaxis_char]], na.rm = TRUE)
        max_aval <- max(vitals[[aval_char]], na.rm = TRUE)
        max_aval_seq <- seq(0, max_aval, 10)

        full_vita <- levels(dataname[[paramcd_char]])
        provided_vita <- paramcd_levels
        known_vita <- c("SYSBP", "DIABP", "TEMP", "RESP", "OXYSAT", "PULSE")

        paramcd_levels_e <- known_vita[stats::na.omit(match(provided_vita, known_vita))]
        len_paramcd_levels_e <- length(paramcd_levels_e)

        all_colors <- stats::setNames(nestcolor::color_palette(length(full_vita), "stream"), full_vita)
        vars_colors <- all_colors[provided_vita]
        names(vars_colors) <- provided_vita

        base_stats <- stats::setNames(c(140, 90, 38, 20, 94, 100), known_vita)
        paramcd_stats_e <- base_stats[paramcd_levels_e]

        base_labels <- stats::setNames(c("140mmHg", "90mmHg", "38\u00B0 C", "20/min", "94%", "100bpm"), known_vita)
        paramcd_labels_e <- base_labels[paramcd_levels_e]

        base_stats_df <- data.frame(
          x = rep(1, len_paramcd_levels_e),
          y = paramcd_stats_e,
          label = paramcd_labels_e,
          color = paramcd_levels_e
        )

        result_plot <- ggplot2::ggplot(data = vitals, mapping = ggplot2::aes(x = xaxis)) + # replaced VSDY
          ggplot2::geom_line(
            data = vitals,
            mapping = ggplot2::aes(y = aval_var, color = paramcd),
            size = 1.5,
            alpha = 0.5
          ) +
          ggplot2::scale_color_manual(
            values = vars_colors
          ) +
          ggplot2::geom_text(
            data = base_stats_df,
            ggplot2::aes(x = x, y = y, label = label, color = color),
            alpha = 1,
            nudge_y = 2.2,
            size = font_size_var / 3.5,
            show.legend = FALSE
          ) +
          ggplot2::geom_hline(
            data = base_stats_df,
            ggplot2::aes(yintercept = y, color = color),
            linetype = 2,
            alpha = 0.5,
            size = 1,
            show.legend = FALSE
          ) +
          ggplot2::scale_y_continuous(
            breaks = seq(0, max(vitals[[xaxis_char]], na.rm = TRUE), 50),
            minor_breaks = seq(0, max(vitals[[aval_char]], na.rm = TRUE), 10)
          ) +
          ggplot2::geom_text(
            data = data.frame(
              x = rep(max_day, length(max_aval_seq)),
              y = max_aval_seq,
              l = as.character(max_aval_seq)
            ),
            ggplot2::aes(
              x = x,
              y = y,
              label = l
            ),
            color = "black",
            alpha = 1,
            nudge_y = 2.2,
            size = font_size_var / 3.5
          ) +
          labs +
          ggthemes +
          themes

        print(result_plot)
      },
      env = list(
        dataname = as.name(dataname),
        paramcd = as.name(paramcd),
        paramcd_char = paramcd,
        paramcd_levels = paramcd_levels,
        xaxis = as.name(xaxis),
        xaxis_char = xaxis,
        aval_var = as.name(aval_var),
        aval_char = aval_var,
        patient_id = patient_id,
        font_size_var = font_size,
        labs = parsed_ggplot2_args$labs,
        ggthemes = parsed_ggplot2_args$ggtheme,
        themes = parsed_ggplot2_args$theme
      )
    )
  )

  y$plot <- bracket_expr(vital_plot)
  y
}

#' teal Module: Patient Profile Vitals Plot
#'
#' This module produces a patient profile vitals [ggplot2::ggplot()] type plot using ADaM datasets.
#'
#' This plot supports horizontal lines for the following 6 `PARAMCD` levels when they are present in `dataname`:
#' `"SYSBP"`, `"DIABP"`, `"TEMP"`, `"RESP"`, `"OXYSAT"`.
#'
#' @inheritParams module_arguments
#' @inheritParams template_vitals
#' @param xaxis ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the time variable from `dataname` to be put on the plot x-axis.
#'
#' @inherit module_arguments return
#'
#' @examples
#' library(nestcolor)
#'
#' ADSL <- tmc_ex_adsl
#' ADVS <- tmc_ex_advs
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADVS = ADVS,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADVS <- tmc_ex_advs
#'     "
#'   ),
#'   modules = modules(
#'     tm_g_pp_vitals(
#'       label = "Vitals",
#'       dataname = "ADVS",
#'       parentname = "ADSL",
#'       patient_col = "USUBJID",
#'       plot_height = c(600L, 200L, 2000L),
#'       paramcd = choices_selected(
#'         choices = variable_choices(ADVS, "PARAMCD"),
#'         selected = "PARAMCD"
#'       ),
#'       xaxis = choices_selected(
#'         choices = variable_choices(ADVS, "ADY"),
#'         selected = "ADY"
#'       ),
#'       aval_var = choices_selected(
#'         choices = variable_choices(ADVS, "AVAL"),
#'         selected = "AVAL"
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_g_pp_vitals <- function(label,
                           dataname = "ADVS",
                           parentname = "ADSL",
                           patient_col = "USUBJID",
                           paramcd = NULL,
                           aval = lifecycle::deprecated(),
                           aval_var = NULL,
                           xaxis = NULL,
                           font_size = c(12L, 12L, 25L),
                           plot_height = c(700L, 200L, 2000L),
                           plot_width = NULL,
                           pre_output = NULL,
                           post_output = NULL,
                           ggplot2_args = teal.widgets::ggplot2_args()) {
  if (lifecycle::is_present(aval)) {
    aval_var <- aval
    warning(
      "The `aval` argument of `tm_g_pp_vitals()` is deprecated as of teal.modules.clinical 0.8.16. ",
      "Please use the `aval_var` argument instead.",
      call. = FALSE
    )
  } else {
    aval <- aval_var # resolves missing argument error
  }

  message("Initializing tm_g_pp_vitals")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(patient_col)
  checkmate::assert_class(paramcd, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(aval_var, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(xaxis, "choices_selected", null.ok = TRUE)
  checkmate::assert_numeric(font_size, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(font_size[1], lower = font_size[2], upper = font_size[3], .var.name = "font_size")
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(ggplot2_args, "ggplot2_args")
  checkmate::assert_multi_class(paramcd, c("choices_selected", "data_extract_spec"), null.ok = TRUE)
  checkmate::assert_multi_class(aval_var, c("choices_selected", "data_extract_spec"), null.ok = TRUE)
  checkmate::assert_multi_class(xaxis, c("choices_selected", "data_extract_spec"), null.ok = TRUE)

  args <- as.list(environment())
  data_extract_list <- list(
    paramcd = `if`(is.null(paramcd), NULL, cs_to_des_select(paramcd, dataname = dataname)),
    aval_var = `if`(is.null(aval_var), NULL, cs_to_des_select(aval_var, dataname = dataname)),
    xaxis = `if`(is.null(xaxis), NULL, cs_to_des_select(xaxis, dataname = dataname))
  )

  module(
    label = label,
    ui = ui_g_vitals,
    ui_args = c(data_extract_list, args),
    server = srv_g_vitals,
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        patient_col = patient_col,
        plot_height = plot_height,
        plot_width = plot_width,
        ggplot2_args = ggplot2_args
      )
    ),
    datanames = c(dataname, parentname)
  )
}

#' @keywords internal
ui_g_vitals <- function(id, ...) {
  ui_args <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    ui_args$paramcd,
    ui_args$aval_var,
    ui_args$xaxis
  )

  ns <- NS(id)
  teal.widgets::standard_layout(
    output = teal.widgets::plot_with_settings_ui(id = ns("vitals_plot")),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(ui_args[c("paramcd", "aval_var", "xaxis")]),
      teal.widgets::optionalSelectInput(
        ns("patient_id"),
        "Select Patient:",
        multiple = FALSE,
        options = shinyWidgets::pickerOptions(`liveSearch` = TRUE)
      ),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select PARAMCD variable:",
        data_extract_spec = ui_args$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      uiOutput(ns("paramcd_levels")),
      teal.transform::data_extract_ui(
        id = ns("xaxis"),
        label = "Select vital plot x-axis:",
        data_extract_spec = ui_args$xaxis,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("aval_var"),
        label = "Select AVAL variable:",
        data_extract_spec = ui_args$aval_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.widgets::panel_item(
        title = "Plot settings",
        collapsed = TRUE,
        teal.widgets::optionalSliderInputValMinMax(
          ns("font_size"), "Font Size", ui_args$font_size,
          ticks = FALSE, step = 1
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = ui_args$pre_output,
    post_output = ui_args$post_output
  )
}

#' @keywords internal
srv_g_vitals <- function(id,
                         data,
                         reporter,
                         filter_panel_api,
                         dataname,
                         parentname,
                         patient_col,
                         paramcd,
                         aval_var,
                         xaxis,
                         plot_height,
                         plot_width,
                         label,
                         ggplot2_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    patient_id <- reactive(input$patient_id)

    # Init
    patient_data_base <- reactive(unique(data()[[parentname]][[patient_col]]))
    teal.widgets::updateOptionalSelectInput(
      session,
      "patient_id",
      choices = patient_data_base(),
      selected = patient_data_base()[1]
    )

    observeEvent(patient_data_base(),
      handlerExpr = {
        teal.widgets::updateOptionalSelectInput(
          session,
          "patient_id",
          choices = patient_data_base(),
          selected = if (length(patient_data_base()) == 1) {
            patient_data_base()
          } else {
            intersect(patient_id(), patient_data_base())
          }
        )
      },
      ignoreInit = TRUE
    )

    # Vitals tab ----

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(paramcd = paramcd, xaxis = xaxis, aval_var = aval_var),
      datasets = data,
      select_validation_rule = list(
        paramcd = shinyvalidate::sv_required(
          "Please select PARAMCD variable."
        ),
        xaxis = shinyvalidate::sv_required(
          "Please select Vitals x-axis variable."
        ),
        aval_var = shinyvalidate::sv_required(
          "Please select AVAL variable."
        )
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("patient_id", shinyvalidate::sv_required(
        "Please select a patient."
      ))
      iv$add_rule("paramcd_levels_vals", shinyvalidate::sv_required(
        "Please select PARAMCD variable levels."
      ))
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::left_join"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr))
    })

    merged <- list(anl_input_r = anl_inputs, anl_q = anl_q)

    output$paramcd_levels <- renderUI({
      paramcd_var <- input[[extract_input("paramcd", dataname)]]

      req(paramcd_var)
      req(input$patient_id)

      vitals_dat <- merged$anl_q()[["ANL"]]
      vitals_dat_sub <- vitals_dat[vitals_dat[[patient_col]] == patient_id(), ]
      paramcd_col <- vitals_dat_sub[[paramcd_var]]
      paramcd_col_levels <- unique(paramcd_col)

      cur_selected <- isolate(input$paramcd_levels_vals)

      selected <- if (length(cur_selected) > 0) {
        cur_selected
      } else {
        paramcd_col_levels
      }

      tagList(
        selectInput(
          session$ns("paramcd_levels_vals"),
          "Select PARAMCD variable levels:",
          selected = selected,
          choices = paramcd_col_levels,
          multiple = TRUE
        )
      )
    })

    all_q <- reactive({
      teal::validate_has_data(merged$anl_q()[["ANL"]], 1)

      teal::validate_inputs(iv_r())

      validate(
        need(
          nrow(merged$anl_q()[["ANL"]][input$patient_id == merged$anl_q()[["ANL"]][, patient_col], ]) > 0,
          "Selected patient is not in dataset (either due to filtering or missing values). Consider relaxing filters."
        )
      )

      my_calls <- template_vitals(
        dataname = "ANL",
        paramcd = input[[extract_input("paramcd", dataname)]],
        paramcd_levels = input[["paramcd_levels_vals"]],
        xaxis = input[[extract_input("xaxis", dataname)]],
        aval_var = input[[extract_input("aval_var", dataname)]],
        patient_id = patient_id(),
        font_size = input[["font_size"]],
        ggplot2_args = ggplot2_args
      )

      teal.code::eval_code(
        merged$anl_q(),
        substitute(
          expr = {
            ANL <- ANL[ANL[[patient_col]] == patient_id, ]
          }, env = list(
            patient_col = patient_col,
            patient_id = patient_id()
          )
        )
      ) %>%
        teal.code::eval_code(as.expression(my_calls))
    })

    plot_r <- reactive(all_q()[["result_plot"]])

    pws <- teal.widgets::plot_with_settings_srv(
      id = "vitals_plot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Patient Profile Vitals Plot",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Plot", "header3")
        card$append_plot(plot_r(), dim = pws$dim())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Exposure Table for Risk management plan
#'
#' Creates a valid expression to generate exposure table for risk management plan.
#'
#' @inheritParams template_arguments
#' @param row_by_var (`character`)\cr variable name used to split the values by rows.
#' @param col_by_var (`character`)\cr variable name used to split the values by columns.
#' @param drop_levels (`flag`)\cr whether empty rows should be removed from the table.
#' @param paramcd_label (`character`)\cr the column from the `dataname` dataset where the
#'   value will be used to label the argument `paramcd`.
#' @param add_total_row (`flag`)\cr whether a "total" level should be added after the others which includes all the
#'   levels that constitute the split. A custom label can be set for this level via the `total_row_label` argument.
#' @param total_row_label (`character`)\cr string to display as total row label if row is
#'   enabled (see `add_total_row`).
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_exposure()]
#'
#' @keywords internal
template_exposure <- function(parentname,
                              dataname,
                              id_var,
                              paramcd,
                              paramcd_label = NULL,
                              row_by_var,
                              col_by_var = NULL,
                              add_total = FALSE,
                              total_label = "Total",
                              add_total_row = TRUE,
                              total_row_label = "Total number of patients and patient time*",
                              drop_levels = TRUE,
                              na_level = default_na_str(),
                              aval_var,
                              avalu_var,
                              basic_table_args = teal.widgets::basic_table_args()) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(row_by_var)
  checkmate::assert_character(col_by_var, null.ok = TRUE)
  checkmate::assert_string(paramcd)
  checkmate::assert_string(id_var)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_flag(add_total_row)
  checkmate::assert_string(total_row_label)
  checkmate::assert_string(na_level)
  checkmate::assert_string(aval_var)
  checkmate::assert_string(avalu_var, null.ok = TRUE)
  checkmate::assert_flag(drop_levels)

  y <- list()
  data_list <- list()

  if (length(col_by_var) == 0) {
    col_by_var <- NULL
  }

  data_list <- add_expr(
    data_list,
    substitute(
      anl <- dataname,
      env = list(
        dataname = as.name(dataname)
      )
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      dataname <- df_explicit_na(dataname, na_level = na_str),
      env = list(
        dataname = as.name("anl"),
        na_str = na_level
      )
    )
  )
  y$data <- bracket_expr(data_list)

  # layout start
  y$layout_prep <- quote(split_fun <- drop_split_levels)

  if (is.null(paramcd_label)) {
    paramcd_label <- paramcd
  }

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(
        show_colcounts = TRUE,
        main_footer = paste0("* Patient time is the sum of ", paramcd_label)
      )
    )
  )

  layout_list <- list()
  layout_list <- add_expr(
    layout_list,
    parsed_basic_table_args
  )

  if (length(col_by_var) > 0) {
    if (add_total) {
      layout_list <- add_expr(
        layout_list,
        substitute(
          rtables::split_cols_by(col_by_var, split_fun = add_overall_level(total_label, first = FALSE)),
          env = list(
            col_by_var = col_by_var,
            total_label = total_label
          )
        )
      )
    } else {
      layout_list <- add_expr(
        layout_list,
        substitute(
          rtables::split_cols_by(col_by_var),
          env = list(
            col_by_var = col_by_var
          )
        )
      )
    }
  }

  layout_list <- add_expr(
    layout_list,
    substitute(
      analyze_patients_exposure_in_cols(
        var = row_by_var,
        ex_var = aval_var,
        col_split = TRUE,
        add_total_level = add_total_row,
        na_str = na_str,
        .labels = c(
          n_patients = "Number of Patients",
          sum_exposure = ifelse(
            avalu_var == " ",
            paste("Sum of", paramcd),
            paste("Sum of", paramcd, sprintf("(%s)", avalu_var))
          )
        ),
        custom_label = total_row_label
      ),
      env = list(
        row_by_var = row_by_var,
        aval_var = aval_var,
        add_total_row = add_total_row,
        na_str = na_level,
        avalu_var = avalu_var,
        paramcd = paramcd,
        total_row_label = total_row_label
      )
    )
  )

  split_label <- substitute(
    expr = teal.data::col_labels(dataname[row_by_var], fill = TRUE),
    env = list(
      dataname = as.name(dataname),
      row_by_var = row_by_var
    )
  )

  layout_list <- add_expr(
    layout_list,
    substitute(
      analyze_patients_exposure_in_cols(
        var = row_by_var,
        col_split = FALSE,
        na_str = na_str
      ) %>%
        append_topleft(c(split_label)),
      env = list(
        row_by_var = row_by_var,
        na_str = na_level,
        split_label = split_label
      )
    )
  )

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  y$table <- substitute(
    expr = {
      result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
      result
    },
    env = list(parent = as.name(parentname))
  )

  if (drop_levels) {
    y$table <- substitute(
      expr = {
        result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
        rtables::prune_table(result)
      },
      env = list(parent = as.name(parentname))
    )
  }
  y
}

#' teal Module: Exposure Table for Risk management plan
#'
#' The module produces an exposure table for risk management plan.
#'
#' @inheritParams module_arguments
#' @inheritParams template_exposure
#' @param row_by_var ([teal.transform::choices_selected()])\cr
#'   object with all available choices and preselected option for
#'   variable names that can be used to split rows.
#' @param col_by_var ([teal.transform::choices_selected()])\cr
#'   object with all available choices and preselected option for
#'   variable names that can be used to split columns.
#' @param parcat ([teal.transform::choices_selected()])\cr
#'   object with all available choices and preselected option for
#'   parameter category values.
#' @param paramcd_label (`character`)\cr the column from the dataset where the value will be used to
#'   label the argument `paramcd`.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' library(dplyr)
#'
#' data <- teal_data()
#' data <- within(data, {
#'   ADSL <- tmc_ex_adsl
#'   ADEX <- tmc_ex_adex
#'
#'   set.seed(1, kind = "Mersenne-Twister")
#'   labels <- col_labels(ADEX, fill = FALSE)
#'   ADEX <- ADEX %>%
#'     distinct(USUBJID, .keep_all = TRUE) %>%
#'     mutate(
#'       PARAMCD = "TDURD",
#'       PARAM = "Overall duration (days)",
#'       AVAL = sample(x = seq(1, 200), size = n(), replace = TRUE),
#'       AVALU = "Days"
#'     ) %>%
#'     bind_rows(ADEX)
#'   col_labels(ADEX) <- labels
#' })
#'
#' datanames <- c("ADSL", "ADEX")
#' datanames(data) <- datanames
#' join_keys(data) <- default_cdisc_join_keys[datanames]
#'
#' app <- init(
#'   data = data,
#'   modules = modules(
#'     tm_t_exposure(
#'       label = "Duration of Exposure Table",
#'       dataname = "ADEX",
#'       paramcd = choices_selected(
#'         choices = value_choices(data[["ADEX"]], "PARAMCD", "PARAM"),
#'         selected = "TDURD"
#'       ),
#'       col_by_var = choices_selected(
#'         choices = variable_choices(data[["ADEX"]], subset = c("SEX", "ARM")),
#'         selected = "SEX"
#'       ),
#'       row_by_var = choices_selected(
#'         choices = variable_choices(data[["ADEX"]], subset = c("RACE", "REGION1", "STRATA1", "SEX")),
#'         selected = "RACE"
#'       ),
#'       parcat = choices_selected(
#'         choices = value_choices(data[["ADEX"]], "PARCAT2"),
#'         selected = "Drug A"
#'       ),
#'       add_total = FALSE
#'     )
#'   ),
#'   filter = teal_slices(teal_slice("ADSL", "SAFFL", selected = "Y"))
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_exposure <- function(label,
                          dataname,
                          parentname = ifelse(
                            inherits(col_by_var, "data_extract_spec"),
                            teal.transform::datanames_input(col_by_var),
                            "ADSL"
                          ),
                          row_by_var,
                          col_by_var,
                          paramcd = teal.transform::choices_selected(
                            choices = teal.transform::value_choices(dataname, "PARAMCD", "PARAM"),
                            selected = "TDURD"
                          ),
                          paramcd_label = "PARAM",
                          id_var = teal.transform::choices_selected(
                            teal.transform::variable_choices(dataname, subset = "USUBJID"),
                            selected = "USUBJID",
                            fixed = TRUE
                          ),
                          parcat,
                          aval_var = teal.transform::choices_selected(
                            teal.transform::variable_choices(dataname, subset = "AVAL"),
                            selected = "AVAL",
                            fixed = TRUE
                          ),
                          avalu_var = teal.transform::choices_selected(
                            teal.transform::variable_choices(dataname, subset = "AVALU"),
                            selected = "AVALU",
                            fixed = TRUE
                          ),
                          add_total,
                          total_label = default_total_label(),
                          add_total_row = TRUE,
                          total_row_label = "Total number of patients and patient time*",
                          na_level = default_na_str(),
                          pre_output = NULL,
                          post_output = NULL,
                          basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_exposure")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(na_level)
  checkmate::assert_class(row_by_var, "choices_selected")
  checkmate::assert_class(col_by_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(id_var, "choices_selected")
  checkmate::assert_class(parcat, "choices_selected")
  checkmate::assert_class(aval_var, "choices_selected")
  checkmate::assert_class(avalu_var, "choices_selected")
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_flag(add_total_row)
  checkmate::assert_string(total_row_label)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  data_extract_list <- list(
    paramcd = cs_to_des_filter(paramcd, dataname = dataname),
    row_by_var = cs_to_des_select(row_by_var, dataname = dataname),
    col_by_var = cs_to_des_select(col_by_var, dataname = parentname),
    id_var = cs_to_des_select(id_var, dataname = dataname),
    parcat = cs_to_des_filter(parcat, dataname = dataname),
    aval_var = cs_to_des_select(aval_var, dataname = dataname),
    avalu_var = cs_to_des_select(avalu_var, dataname = dataname)
  )

  args <- as.list(environment())
  module(
    label = label,
    ui = ui_t_exposure,
    server = srv_t_exposure,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        total_label = total_label,
        total_row_label = total_row_label,
        na_level = na_level,
        basic_table_args = basic_table_args,
        paramcd_label = paramcd_label
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}


#' @keywords internal
ui_t_exposure <- function(id, ...) {
  ns <- NS(id)
  a <- list(...) # module args

  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$paramcd,
    a$col_by_var,
    a$row_by_var,
    a$id_var,
    a$parcat,
    a$aval_var,
    a$avalu_var
  )

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c(
        "paramcd", "col_by_var", "row_by_var", "id_var", "parcat", "aval_var", "avalu_var"
      )]),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select the Parameter",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("parcat"),
        label = "Select the Parameter Category",
        data_extract_spec = a$parcat,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("col_by_var"),
        label = "Select Column by Variable",
        data_extract_spec = a$col_by_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("row_by_var"),
        label = "Select Row by Variable",
        data_extract_spec = a$row_by_var,
        is_single_dataset = is_single_dataset_value
      ),
      checkboxInput(ns("add_total_row"), "Add Total row", value = a$add_total_row),
      checkboxInput(ns("add_total"), "Add All Patients column", value = a$add_total),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional Variables Info",
          teal.transform::data_extract_ui(
            id = ns("id_var"),
            label = "Subject Identifier",
            data_extract_spec = a$id_var,
            is_single_dataset = is_single_dataset_value
          ),
          teal.transform::data_extract_ui(
            id = ns("aval_var"),
            label = "Analysis Value Variable",
            data_extract_spec = a$aval_var,
            is_single_dataset = is_single_dataset_value
          ),
          teal.transform::data_extract_ui(
            id = ns("avalu_var"),
            label = "Analysis Value Unit Variable",
            data_extract_spec = a$avalu_var,
            is_single_dataset = is_single_dataset_value
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_t_exposure <- function(id,
                           data,
                           reporter,
                           filter_panel_api,
                           dataname,
                           parentname,
                           paramcd,
                           paramcd_label,
                           id_var,
                           row_by_var,
                           col_by_var,
                           parcat,
                           aval_var,
                           avalu_var,
                           na_level,
                           label,
                           total_label,
                           total_row_label,
                           basic_table_args = basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")
  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    rule_intersection <- function(other) {
      function(value) {
        others <- selector_list()[[other]]()$select
        if (length(intersect(value, others)) > 0L) {
          "Column by and row by variables should not be the same."
        }
      }
    }

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        id_var = id_var,
        paramcd = paramcd,
        row_by_var = row_by_var,
        col_by_var = col_by_var,
        parcat = parcat,
        aval_var = aval_var,
        avalu_var = avalu_var
      ),
      datasets = data,
      select_validation_rule = list(
        id_var = shinyvalidate::sv_required("Subject Identifier is required"),
        col_by_var = shinyvalidate::compose_rules(
          shinyvalidate::sv_optional(),
          rule_intersection("row_by_var")
        ),
        row_by_var = shinyvalidate::compose_rules(
          shinyvalidate::sv_required("Please select a row by variable."),
          rule_intersection("col_by_var")
        ),
        aval_var = shinyvalidate::sv_required("Please select an analysis variable."),
        avalu_var = shinyvalidate::sv_required("Please select an analysis unit variable.")
      ),
      filter_validation_rule = list(
        paramcd = shinyvalidate::sv_required("Please select a parameter value."),
        parcat = shinyvalidate::sv_required("Please select a parameter category value.")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(col_by_var = col_by_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    validate_checks <- reactive({
      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]

      teal::validate_inputs(iv_r())

      input_paramcd <- unlist(paramcd$filter)["vars_selected"]
      input_id_var <- names(merged$anl_input_r()$columns_source$id_var)
      input_row_by_var <- names(merged$anl_input_r()$columns_source$row_by_var)
      input_col_by_var <- names(merged$adsl_input_r()$columns_source$col_by_var)
      input_parcat <- unlist(parcat$filter)["vars_selected"]
      input_aval_var <- names(merged$anl_input_r()$columns_source$aval_var)
      input_avalu_var <- names(merged$anl_input_r()$columns_source$avalu_var)

      # validate inputs
      validate_standard_inputs(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_col_by_var),
        anl = anl_filtered,
        anlvars = c(
          "USUBJID", "STUDYID", input_id_var, input_paramcd,
          input_row_by_var, input_parcat, input_aval_var, input_avalu_var
        ),
        arm_var = NULL,
        need_arm = FALSE
      )
      NULL
    })

    all_q <- reactive({
      validate_checks()

      anl_filtered <- merged$anl_q()[[dataname]]
      input_avalu_var <- as.character(
        unique(merged$anl_q()[["ANL"]][[names(merged$anl_input_r()$columns_source$avalu_var)[1]]])
      )
      input_paramcd <- as.character(
        unique(merged$anl_q()[["ANL"]][[names(merged$anl_input_r()$columns_source$paramcd)[1]]])
      )

      if (is.null(paramcd_label)) {
        input_paramcd_label <- input_paramcd
      } else {
        paramcd <- names(merged$anl_input_r()$columns_source$paramcd)
        paramcd_map_list <- c(paramcd, paramcd_label)
        paramcd_map <- unique(anl_filtered[paramcd_map_list])
        input_paramcd_label <- as.character(paramcd_map[paramcd_map[1] == input_paramcd, 2])
      }

      basic_table_args$title <- "Duration of Exposure Table"
      basic_table_args$subtitles <-
        paste("Parameter Category:", merged$anl_input_r()$filter_info$parcat[[1]]$selected[[1]])

      my_calls <- template_exposure(
        parentname = "ANL_ADSL",
        dataname = "ANL",
        id_var = names(merged$anl_input_r()$columns_source$id_var),
        paramcd = input_paramcd,
        paramcd_label = input_paramcd_label,
        row_by_var = names(merged$anl_input_r()$columns_source$row_by_var),
        col_by_var = names(merged$anl_input_r()$columns_source$col_by_var),
        add_total = input$add_total,
        total_label = total_label,
        add_total_row = input$add_total_row,
        total_row_label = total_row_label,
        drop_levels = TRUE,
        na_level = na_level,
        aval_var = names(merged$anl_input_r()$columns_source$aval_var),
        avalu_var = input_avalu_var,
        basic_table_args = basic_table_args
      )
      teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
    })

    # Outputs to render.
    table_r <- reactive(all_q()[["result"]])

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    # Render R code.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Exposure for Risk Management Plan Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Kaplan-Meier Plot
#'
#' Creates a valid expression to generate a Kaplan-Meier plot.
#'
#' @inheritParams template_arguments
#' @inheritParams tern::g_km
#' @inheritParams tern::control_coxreg
#' @param facet_var (`character`)\cr name of the variable to use to facet the plot.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_g_km()]
#'
#' @keywords internal
template_g_km <- function(dataname = "ANL",
                          arm_var = "ARM",
                          ref_arm = NULL,
                          comp_arm = NULL,
                          compare_arm = FALSE,
                          combine_comp_arms = FALSE,
                          aval_var = "AVAL",
                          cnsr_var = "CNSR",
                          xticks = NULL,
                          strata_var = NULL,
                          time_points = NULL,
                          facet_var = "SEX",
                          font_size = 11,
                          conf_level = 0.95,
                          ties = "efron",
                          xlab = "Survival time",
                          time_unit_var = "AVALU",
                          yval = "Survival",
                          ylim = NULL,
                          pval_method = "log-rank",
                          annot_surv_med = TRUE,
                          annot_coxph = TRUE,
                          control_annot_surv_med = control_surv_med_annot(),
                          control_annot_coxph = control_coxph_annot(x = 0.27, y = 0.35, w = 0.3),
                          legend_pos = NULL,
                          position_coxph = lifecycle::deprecated(),
                          width_annots = lifecycle::deprecated(),
                          rel_height_plot = 0.80,
                          ci_ribbon = FALSE,
                          title = "KM Plot") {
  if (lifecycle::is_present(position_coxph)) {
    control_annot_coxph[["x"]] <- position_coxph[1]
    control_annot_coxph[["y"]] <- position_coxph[2]
    lifecycle::deprecate_warn(
      "0.8.17",
      "template_g_km(position_coxph)",
      details = "Please use the 'x' and 'y' elements of the `control_annot_coxph` argument instead."
    )
  }
  if (lifecycle::is_present(width_annots)) {
    control_annot_surv_med[["w"]] <- width_annots[["surv_med"]]
    control_annot_coxph[["w"]] <- width_annots[["coxph"]]
    lifecycle::deprecate_warn(
      "0.8.17",
      "template_g_km(width_annots)",
      details = paste(
        "Please use the 'w' element of the `control_annot_surv_med`",
        "and `control_annot_coxph` arguments instead."
      )
    )
  }
  checkmate::assert_string(dataname)
  checkmate::assert_string(arm_var)
  checkmate::assert_string(aval_var)
  checkmate::assert_string(cnsr_var)
  checkmate::assert_string(time_unit_var)
  checkmate::assert_flag(compare_arm)
  checkmate::assert_flag(combine_comp_arms)
  checkmate::assert_numeric(xticks, null.ok = TRUE)
  checkmate::assert_string(title)
  checkmate::assert_number(font_size)
  checkmate::assert_number(rel_height_plot, lower = 0, upper = 1)

  ref_arm_val <- paste(ref_arm, collapse = "/")
  y <- list()

  data_list <- list()
  data_list <- add_expr(
    data_list,
    prepare_arm(
      dataname = dataname,
      arm_var = arm_var,
      ref_arm = ref_arm,
      comp_arm = comp_arm,
      compare_arm = compare_arm,
      ref_arm_val = ref_arm_val
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = dplyr::mutate(
        is_event = cnsr_var == 0
      ),
      env = list(
        anl = as.name(dataname),
        cnsr_var = as.name(cnsr_var)
      )
    )
  )

  if (compare_arm && combine_comp_arms) {
    comp_arm_val <- paste(comp_arm, collapse = "/")
    data_list <- add_expr(
      data_list,
      substitute_names(
        expr = dplyr::mutate(arm_var = combine_levels(arm_var, levels = comp_arm, new_level = comp_arm_val)),
        names = list(arm_var = as.name(arm_var)),
        others = list(comp_arm = comp_arm, comp_arm_val = comp_arm_val)
      )
    )
  }

  y$data <- substitute(
    expr = {
      anl <- data_pipe
    },
    env = list(
      data_pipe = pipe_expr(data_list)
    )
  )

  y$variables <- if (length(strata_var) != 0) {
    substitute(
      expr = variables <- list(tte = tte, is_event = "is_event", arm = arm, strata = strata_var),
      env = list(tte = aval_var, arm = arm_var, strata_var = strata_var)
    )
  } else {
    substitute(
      expr = variables <- list(tte = tte, is_event = "is_event", arm = arm),
      env = list(tte = aval_var, arm = arm_var)
    )
  }
  graph_list <- list()

  if (length(facet_var) != 0L) {
    graph_list <- add_expr(
      graph_list,
      substitute(
        expr = {
          facets <- droplevels(anl$facet_var)
          anl <- split(anl, f = facets)
        },
        env = list(
          facet_var = as.name(facet_var)
        )
      )
    )
  } else {
    graph_list <- add_expr(
      graph_list,
      substitute(
        expr = {
          facets <- NULL
          anl <- list(anl)
        }
      )
    )
  }

  graph_list <- add_expr(
    graph_list,
    substitute(
      expr = {
        g_km_counter_generator <- function() {
          plot_number <- 0L
          function(x) {
            plot_number <<- plot_number + 1L
            g_km(
              x,
              variables = variables,
              control_surv = control_surv_timepoint(conf_level = conf_level),
              xticks = xticks,
              xlab = sprintf(
                "%s (%s)",
                xlab,
                gsub("(^|[[:space:]])([[:alpha:]])", "\\1\\U\\2", tolower(x$time_unit_var[1]), perl = TRUE)
              ),
              yval = yval,
              ylim = ylim,
              title = sprintf(
                "%s%s",
                sprintf(
                  "%s%s",
                  title,
                  if (!is.null(facets)) {
                    sprintf(", %s = %s", as.character(quote(facet_var)), unique(x[[as.character(quote(facet_var))]]))
                  } else {
                    ""
                  }
                ),
                if (length(strata_var) != 0) {
                  sprintf("\nStratified by %s", toString(strata_var))
                } else {
                  ""
                }
              ),
              footnotes = if (annot_coxph) {
                paste(
                  "Ties for Coxph (Hazard Ratio):", ties, "\n",
                  "p-value Method for Coxph (Hazard Ratio):", pval_method
                )
              },
              font_size = font_size,
              ci_ribbon = ci_ribbon,
              annot_surv_med = annot_surv_med,
              annot_coxph = annot_coxph,
              control_coxph_pw = control_coxph(conf_level = conf_level, pval_method = pval_method, ties = ties),
              control_annot_surv_med = control_annot_surv_med,
              control_annot_coxph = control_annot_coxph,
              legend_pos = legend_pos,
              rel_height_plot = rel_height_plot
            )
          }
        }

        g_km_counter <- g_km_counter_generator()

        plot_list <- lapply(
          anl,
          g_km_counter
        )

        plot <- cowplot::plot_grid(
          plotlist = plot_list,
          ncol = 1
        )
        plot
      },
      env = list(
        facet_var = if (length(facet_var) != 0L) as.name(facet_var),
        font_size = font_size,
        strata_var = strata_var,
        xticks = xticks,
        xlab = xlab,
        time_unit_var = as.name(time_unit_var),
        yval = yval,
        ylim = ylim,
        conf_level = conf_level,
        pval_method = pval_method,
        annot_surv_med = annot_surv_med,
        annot_coxph = annot_coxph,
        control_annot_surv_med = control_annot_surv_med,
        control_annot_coxph = control_annot_coxph,
        legend_pos = legend_pos,
        ties = ties,
        ci_ribbon = ci_ribbon,
        rel_height_plot = rel_height_plot,
        title = title
      )
    )
  )

  y$graph <- bracket_expr(graph_list)
  y
}

#' teal Module: Kaplan-Meier Plot
#'
#' This module produces a `ggplot`-style Kaplan-Meier plot for data with ADaM structure.
#'
#' @inheritParams module_arguments
#' @inheritParams template_g_km
#' @param facet_var ([teal.transform::choices_selected()])\cr object with
#'   all available choices and preselected option for names of variable that can be used for plot faceting.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' library(nestcolor)
#'
#' ADSL <- tmc_ex_adsl
#' ADTTE <- tmc_ex_adtte
#'
#' arm_ref_comp <- list(
#'   ACTARMCD = list(
#'     ref = "ARM B",
#'     comp = c("ARM A", "ARM C")
#'   ),
#'   ARM = list(
#'     ref = "B: Placebo",
#'     comp = c("A: Drug X", "C: Combination")
#'   )
#' )
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADTTE = ADTTE,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADTTE <- tmc_ex_adtte
#'     "
#'   ),
#'   modules = modules(
#'     tm_g_km(
#'       label = "Kaplan-Meier Plot",
#'       dataname = "ADTTE",
#'       arm_var = choices_selected(
#'         variable_choices(ADSL, c("ARM", "ARMCD", "ACTARMCD")),
#'         "ARM"
#'       ),
#'       paramcd = choices_selected(
#'         value_choices(ADTTE, "PARAMCD", "PARAM"),
#'         "OS"
#'       ),
#'       arm_ref_comp = arm_ref_comp,
#'       strata_var = choices_selected(
#'         variable_choices(ADSL, c("SEX", "BMRKR2")),
#'         "SEX"
#'       ),
#'       facet_var = choices_selected(
#'         variable_choices(ADSL, c("SEX", "BMRKR2")),
#'         NULL
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_g_km <- function(label,
                    dataname,
                    parentname = ifelse(
                      inherits(arm_var, "data_extract_spec"),
                      teal.transform::datanames_input(arm_var),
                      "ADSL"
                    ),
                    arm_var,
                    arm_ref_comp = NULL,
                    paramcd,
                    strata_var,
                    facet_var,
                    time_unit_var = teal.transform::choices_selected(
                      teal.transform::variable_choices(dataname, "AVALU"), "AVALU",
                      fixed = TRUE
                    ),
                    aval_var = teal.transform::choices_selected(
                      teal.transform::variable_choices(dataname, "AVAL"), "AVAL",
                      fixed = TRUE
                    ),
                    cnsr_var = teal.transform::choices_selected(
                      teal.transform::variable_choices(dataname, "CNSR"), "CNSR",
                      fixed = TRUE
                    ),
                    conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE),
                    font_size = c(11L, 1L, 30),
                    control_annot_surv_med = control_surv_med_annot(),
                    control_annot_coxph = control_coxph_annot(x = 0.27, y = 0.35, w = 0.3),
                    legend_pos = c(0.9, 0.5),
                    rel_height_plot = c(80L, 0L, 100L),
                    plot_height = c(800L, 400L, 5000L),
                    plot_width = NULL,
                    pre_output = NULL,
                    post_output = NULL) {
  message("Initializing tm_g_km")

  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(strata_var, "choices_selected")
  checkmate::assert_class(facet_var, "choices_selected")
  checkmate::assert_class(time_unit_var, "choices_selected")
  checkmate::assert_class(aval_var, "choices_selected")
  checkmate::assert_class(cnsr_var, "choices_selected")
  checkmate::assert_class(conf_level, "choices_selected")
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)

  args <- as.list(environment())
  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname),
    strata_var = cs_to_des_select(strata_var, dataname = parentname, multiple = TRUE),
    facet_var = cs_to_des_select(facet_var, dataname = parentname, multiple = FALSE),
    aval_var = cs_to_des_select(aval_var, dataname = dataname),
    cnsr_var = cs_to_des_select(cnsr_var, dataname = dataname),
    time_unit_var = cs_to_des_select(time_unit_var, dataname = dataname)
  )

  module(
    label = label,
    server = srv_g_km,
    ui = ui_g_km,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        label = label,
        parentname = parentname,
        arm_ref_comp = arm_ref_comp,
        plot_height = plot_height,
        plot_width = plot_width,
        control_annot_surv_med = control_annot_surv_med,
        control_annot_coxph = control_annot_coxph,
        legend_pos = legend_pos
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_g_km <- function(id, ...) {
  a <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$arm_var,
    a$paramcd,
    a$strata_var,
    a$facet_var,
    a$aval_var,
    a$cnsr_var,
    a$time_unit_var
  )

  ns <- NS(id)

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(
      verbatimTextOutput(outputId = ns("text")),
      teal.widgets::plot_with_settings_ui(
        id = ns("myplot")
      )
    ),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c("arm_var", "paramcd", "strata_var", "facet_var", "aval_var", "cnsr_var")]),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select Endpoint",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("aval_var"),
        label = "Analysis Variable",
        data_extract_spec = a$aval_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("cnsr_var"),
        label = "Censor Variable",
        data_extract_spec = a$cnsr_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("facet_var"),
        label = "Facet Plots by",
        data_extract_spec = a$facet_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      tags$div(
        class = "arm-comp-box",
        tags$label("Compare Treatments"),
        shinyWidgets::switchInput(
          inputId = ns("compare_arms"),
          value = !is.null(a$arm_ref_comp),
          size = "mini"
        ),
        conditionalPanel(
          condition = paste0("input['", ns("compare_arms"), "']"),
          tags$div(
            uiOutput(
              ns("arms_buckets"),
              title = paste(
                "Multiple reference groups are automatically combined into a single group when more than one",
                "value is selected."
              )
            ),
            checkboxInput(
              ns("combine_comp_arms"),
              "Combine all comparison groups?",
              value = FALSE
            ),
            teal.transform::data_extract_ui(
              id = ns("strata_var"),
              label = "Stratify by",
              data_extract_spec = a$strata_var,
              is_single_dataset = is_single_dataset_value
            )
          )
        )
      ),
      conditionalPanel(
        condition = paste0("input['", ns("compare_arms"), "']"),
        teal.widgets::panel_group(
          teal.widgets::panel_item(
            "Comparison settings",
            radioButtons(
              ns("pval_method_coxph"),
              label = HTML(
                paste(
                  "p-value method for ",
                  tags$span(class = "text-primary", "Coxph"),
                  " (Hazard Ratio)",
                  sep = ""
                )
              ),
              choices = c("wald", "log-rank", "likelihood"),
              selected = "log-rank"
            ),
            radioButtons(
              ns("ties_coxph"),
              label = HTML(
                paste(
                  "Ties for ",
                  tags$span(class = "text-primary", "Coxph"),
                  " (Hazard Ratio)",
                  sep = ""
                )
              ),
              choices = c("exact", "breslow", "efron"),
              selected = "exact"
            )
          )
        )
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional plot settings",
          textInput(
            inputId = ns("xticks"),
            label = "Specify break intervals for x-axis e.g. 0 ; 500"
          ),
          radioButtons(
            ns("yval"),
            tags$label("Value on y-axis", class = "text-primary"),
            choices = c("Survival probability", "Failure probability"),
            selected = c("Survival probability"),
          ),
          teal.widgets::optionalSliderInput(
            ns("ylim"),
            tags$label("y-axis limits", class = "text-primary"),
            value = c(0, 1),
            min = 0, max = 1
          ),
          teal.widgets::optionalSliderInputValMinMax(
            ns("font_size"),
            "Table Font Size",
            a$font_size,
            ticks = FALSE, step = 1
          ),
          teal.widgets::optionalSliderInputValMinMax(
            ns("rel_height_plot"),
            "Relative Height of Plot (%)",
            a$rel_height_plot,
            ticks = FALSE, step = 1
          ),
          checkboxInput(
            inputId = ns("show_ci_ribbon"),
            label = "Show CI ribbon",
            value = FALSE,
            width = "100%"
          ),
          checkboxInput(
            inputId = ns("show_km_table"),
            label = "Show KM table",
            value = TRUE,
            width = "100%"
          ),
          teal.widgets::optionalSelectInput(
            ns("conf_level"),
            "Level of Confidence",
            a$conf_level$choices,
            a$conf_level$selected,
            multiple = FALSE,
            fixed = a$conf_level$fixed
          ),
          textInput(ns("xlab"), "X-axis label", "Time"),
          teal.transform::data_extract_ui(
            id = ns("time_unit_var"),
            label = "Time Unit Variable",
            data_extract_spec = a$time_unit_var,
            is_single_dataset = is_single_dataset_value
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_g_km <- function(id,
                     data,
                     reporter,
                     filter_panel_api,
                     dataname,
                     parentname,
                     paramcd,
                     arm_var,
                     arm_ref_comp,
                     strata_var,
                     facet_var,
                     aval_var,
                     cnsr_var,
                     label,
                     time_unit_var,
                     plot_height,
                     plot_width,
                     control_annot_surv_med,
                     control_annot_coxph,
                     legend_pos) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    # Setup arm variable selection, default reference arms and default
    # comparison arms for encoding panel
    iv_arm_ref <- arm_ref_comp_observer(
      session,
      input,
      output,
      id_arm_var = extract_input("arm_var", parentname),
      data = data()[[parentname]],
      arm_ref_comp = arm_ref_comp,
      module = "tm_t_tte",
      on_off = reactive(input$compare_arms)
    )

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        aval_var = aval_var,
        cnsr_var = cnsr_var,
        arm_var = arm_var,
        paramcd = paramcd,
        strata_var = strata_var,
        facet_var = facet_var,
        time_unit_var = time_unit_var
      ),
      datasets = data,
      select_validation_rule = list(
        aval_var = shinyvalidate::sv_required("An analysis variable is required"),
        cnsr_var = shinyvalidate::sv_required("A censor variable is required"),
        arm_var = shinyvalidate::sv_required("A treatment variable is required")
      ),
      filter_validation_rule = list(
        paramcd = shinyvalidate::sv_required("An endpoint is required")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()

      if (isTRUE(input$compare_arms)) {
        iv$add_validator(iv_arm_ref)
      }

      iv$add_rule("font_size", shinyvalidate::sv_required("Plot tables font size must be greater than or equal to 5"))
      iv$add_rule("font_size", shinyvalidate::sv_gte(5, "Plot tables font size must be greater than or equal to 5"))
      iv$add_rule("ylim", shinyvalidate::sv_required("Please choose a range for y-axis limits"))
      iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level"))
      iv$add_rule(
        "conf_level",
        shinyvalidate::sv_between(
          0, 1,
          inclusive = c(FALSE, FALSE),
          message_fmt = "Confidence level must be between 0 and 1"
        )
      )
      iv$add_rule("xticks", shinyvalidate::sv_optional())
      iv$add_rule(
        "xticks",
        function(value) {
          val <- as_numeric_from_comma_sep_str(value, sep = ";")
          if (anyNA(val) || any(val < 0)) {
            "All break intervals for x-axis must be non-negative numbers separated by semicolons"
          } else if (all(val == 0)) {
            "At least one break interval for x-axis must be > 0"
          }
        }
      )
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(code = as.expression(anl_inputs()$expr))
    })

    validate_checks <- reactive({
      teal::validate_inputs(iv_r())

      adsl_filtered <- anl_q()[[parentname]]
      anl_filtered <- anl_q()[[dataname]]

      anl_m <- anl_inputs()
      input_arm_var <- as.vector(anl_m$columns_source$arm_var)
      input_strata_var <- as.vector(anl_m$columns_source$strata_var)
      input_facet_var <- as.vector(anl_m$columns_source$facet_var)
      input_aval_var <- as.vector(anl_m$columns_source$aval_var)
      input_cnsr_var <- as.vector(anl_m$columns_source$cnsr_var)
      input_paramcd <- unlist(paramcd$filter)["vars_selected"]
      input_time_unit_var <- as.vector(anl_m$columns_source$time_unit_var)

      # validate inputs
      validate_args <- list(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var, input_strata_var, input_facet_var),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_paramcd, input_aval_var, input_cnsr_var, input_time_unit_var),
        arm_var = input_arm_var
      )

      # validate arm levels
      if (length(input_arm_var) > 0 && length(unique(adsl_filtered[[input_arm_var]])) == 1) {
        validate_args <- append(validate_args, list(min_n_levels_armvar = NULL))
      }
      if (isTRUE(input$compare_arms)) {
        validate_args <- append(
          validate_args,
          list(ref_arm = unlist(input$buckets$Ref), comp_arm = unlist(input$buckets$Comp))
        )
      }
      do.call(what = "validate_standard_inputs", validate_args)

      NULL
    })

    all_q <- reactive({
      validate_checks()

      anl_m <- anl_inputs()

      anl <- anl_q()[["ANL"]]
      teal::validate_has_data(anl, 2)

      input_xticks <- if (!is.null(input$xticks)) {
        as_numeric_from_comma_sep_str(input$xticks, sep = ";")
      }

      input_paramcd <- as.character(unique(anl[[as.vector(anl_m$columns_source$paramcd)]]))
      title <- paste("KM Plot of", input_paramcd)

      my_calls <- template_g_km(
        dataname = "ANL",
        arm_var = as.vector(anl_m$columns_source$arm_var),
        ref_arm = unlist(input$buckets$Ref),
        comp_arm = unlist(input$buckets$Comp),
        compare_arm = input$compare_arms,
        combine_comp_arms = input$combine_comp_arms,
        aval_var = as.vector(anl_m$columns_source$aval_var),
        cnsr_var = as.vector(anl_m$columns_source$cnsr_var),
        strata_var = as.vector(anl_m$columns_source$strata_var),
        time_points = NULL,
        time_unit_var = as.vector(anl_m$columns_source$time_unit_var),
        facet_var = as.vector(anl_m$columns_source$facet_var),
        annot_surv_med = input$show_km_table,
        annot_coxph = input$compare_arms,
        control_annot_surv_med = control_annot_surv_med,
        control_annot_coxph = control_annot_coxph,
        legend_pos = legend_pos,
        xticks = input_xticks,
        font_size = input$font_size,
        pval_method = input$pval_method_coxph,
        conf_level = as.numeric(input$conf_level),
        ties = input$ties_coxph,
        xlab = input$xlab,
        yval = ifelse(input$yval == "Survival probability", "Survival", "Failure"),
        ylim = input$ylim,
        rel_height_plot = input$rel_height_plot / 100,
        ci_ribbon = input$show_ci_ribbon,
        title = title
      )
      teal.code::eval_code(anl_q(), as.expression(my_calls))
    })

    plot_r <- reactive(all_q()[["plot"]])

    # Insert the plot into a plot with settings module from teal.widgets
    pws <- teal.widgets::plot_with_settings_srv(
      id = "myplot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Kaplan Meier Plot",
          label = label,
          description = "Non-parametric method used to estimate the survival function from lifetime data",
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Plot", "header3")
        card$append_plot(plot_r(), dim = pws$dim())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Events by Grade
#'
#' Creates a valid expression to generate a table to summarize events by grade.
#'
#' @inheritParams template_arguments
#' @param id (`character`)\cr unique identifier of patients in datasets, default to `"USUBJID"`.
#' @param grade (`character`)\cr name of the severity level variable.
#' @param label_grade (`string`)\cr label of the `grade` variable from `dataname`. The label will be extracted from the
#' module.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_events_by_grade()]
#'
#' @keywords internal
template_events_by_grade <- function(dataname,
                                     parentname,
                                     arm_var,
                                     id = "",
                                     hlt,
                                     llt,
                                     label_hlt = NULL,
                                     label_llt = NULL,
                                     grade,
                                     label_grade = NULL,
                                     prune_freq = 0,
                                     prune_diff = 0,
                                     add_total = TRUE,
                                     total_label = default_total_label(),
                                     na_level = default_na_str(),
                                     drop_arm_levels = TRUE,
                                     basic_table_args = teal.widgets::basic_table_args()) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(arm_var)
  checkmate::assert_string(hlt, null.ok = TRUE)
  checkmate::assert_string(llt, null.ok = TRUE)
  if (is.null(hlt) && is.null(llt)) stop("At least one of 'hlt' or 'llt' can not be empty.")
  checkmate::assert_string(label_hlt, null.ok = TRUE)
  checkmate::assert_string(label_llt, null.ok = TRUE)
  checkmate::assert_string(grade)
  checkmate::assert_string(label_grade, null.ok = TRUE)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_string(na_level)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_scalar(prune_freq)
  checkmate::assert_scalar(prune_diff)

  y <- list()

  data_list <- list()

  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl <- dataname,
      env = list(
        dataname = as.name(dataname)
      )
    )
  )

  data_list <- add_expr(
    data_list,
    prepare_arm_levels(
      dataname = "anl",
      parentname = parentname,
      arm_var = arm_var,
      drop_arm_levels = drop_arm_levels
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = dataname <- df_explicit_na(dataname, na_level = na_str),
      env = list(dataname = as.name(dataname), na_str = na_level)
    )
  )
  data_list <- add_expr(
    data_list,
    substitute(
      expr = dataname <- df_explicit_na(dataname, na_level = na_str),
      env = list(dataname = as.name("anl"), na_str = na_level)
    )
  )
  data_list <- add_expr(
    data_list,
    substitute(
      expr = parentname <- df_explicit_na(parentname, na_level = na_str),
      env = list(parentname = as.name(parentname), na_str = na_level)
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = grade_groups <- list("- Any Intensity -" = levels(dataname$grade)),
      env = list(
        dataname = as.name(dataname),
        grade = grade
      )
    )
  )

  y$data <- bracket_expr(data_list)

  y$layout_prep <- quote(split_fun <- trim_levels_in_group)

  layout_list <- list()

  basic_title <- if (is.null(hlt) && !is.null(llt)) {
    paste0("Adverse Event summary by ", label_grade, ": ", label_llt)
  } else if (!is.null(hlt) && is.null(llt)) {
    paste0("Adverse Event summary by ", label_grade, ": ", label_hlt)
  } else if (!is.null(hlt) && !is.null(llt)) {
    paste0("Adverse Event summary by ", label_grade, ": ", label_hlt, " and ", label_llt)
  } else {
    paste0("Adverse Event summary by ", label_grade)
  }

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(show_colcounts = TRUE, title = basic_title)
    )
  )

  layout_list <- add_expr(
    layout_list,
    parsed_basic_table_args
  )

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = rtables::split_cols_by(arm_var),
      env = list(arm_var = arm_var)
    )
  )

  if (add_total) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = rtables::add_overall_col(label = total_label),
        env = list(total_label = total_label)
      )
    )
  }

  one_term <- is.null(hlt) || is.null(llt)

  if (one_term) {
    term_var <- ifelse(is.null(hlt), llt, hlt)
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = summarize_occurrences_by_grade(
          var = grade,
          grade_groups = grade_groups,
          na_str = na_str
        ) %>%
          rtables::split_rows_by(
            term_var,
            child_labels = "visible",
            nested = TRUE,
            indent_mod = -1L,
            split_fun = split_fun(grade),
            label_pos = "topleft",
            split_label = teal.data::col_labels(dataname[term_var])
          ) %>%
          summarize_num_patients(
            var = id,
            .stats = "unique",
            .labels = c("- Any Intensity -"),
            na_str = na_str
          ) %>%
          count_occurrences_by_grade(var = grade, .indent_mods = -1L, na_str = na_str) %>%
          append_varlabels(dataname, grade, indent = 1L),
        env = list(
          id = id,
          arm_var = arm_var,
          term_var = term_var,
          grade = grade,
          dataname = as.name(dataname),
          na_str = na_level
        )
      )
    )
  } else {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = summarize_occurrences_by_grade(
          var = grade,
          grade_groups = grade_groups,
          na_str = na_str
        ) %>%
          rtables::split_rows_by(
            hlt,
            child_labels = "visible",
            nested = TRUE,
            indent_mod = -1L,
            split_fun = split_fun(grade),
            label_pos = "topleft",
            split_label = teal.data::col_labels(dataname[hlt])
          ) %>%
          summarize_occurrences_by_grade(
            var = grade,
            grade_groups = grade_groups,
            na_str = na_str
          ) %>%
          rtables::split_rows_by(
            llt,
            child_labels = "visible",
            nested = TRUE,
            indent_mod = -1L,
            split_fun = split_fun(grade),
            label_pos = "topleft",
            split_label = teal.data::col_labels(dataname[llt])
          ) %>%
          summarize_num_patients(
            var = id,
            .stats = "unique",
            .labels = c("- Any Intensity -"),
            na_str = na_str
          ) %>%
          count_occurrences_by_grade(var = grade, .indent_mods = -1L, na_str = na_str) %>%
          append_varlabels(dataname, grade, indent = 2L),
        env = list(
          id = id,
          arm_var = arm_var,
          hlt = hlt,
          llt = llt,
          grade = grade,
          dataname = as.name(dataname),
          na_str = na_level
        )
      )
    )
  }

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  # Full table.
  y$table <- substitute(
    expr = result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent),
    env = list(parent = as.name(parentname))
  )

  # Start pruning table.
  prune_list <- list()
  prune_list <- add_expr(
    prune_list,
    quote(
      pruned_result <- result
    )
  )

  if (prune_freq > 0 || prune_diff > 0) {
    # Do not use "All Patients" column for pruning conditions.
    prune_list <- add_expr(
      prune_list,
      substitute(
        expr = col_indices <- 1:(ncol(result) - add_total),
        env = list(add_total = add_total)
      )
    )

    if (prune_freq > 0 && prune_diff == 0) {
      prune_list <- add_expr(
        prune_list,
        substitute(
          expr = row_condition <- has_fraction_in_any_col(atleast = prune_freq, col_indices = col_indices),
          env = list(prune_freq = prune_freq)
        )
      )
    } else if (prune_freq == 0 && prune_diff > 0) {
      prune_list <- add_expr(
        prune_list,
        substitute(
          expr = row_condition <- has_fractions_difference(atleast = prune_diff, col_indices = col_indices),
          env = list(prune_diff = prune_diff)
        )
      )
    } else if (prune_freq > 0 && prune_diff > 0) {
      prune_list <- add_expr(
        prune_list,
        substitute(
          expr = row_condition <- has_fraction_in_any_col(atleast = prune_freq, col_indices = col_indices) &
            has_fractions_difference(atleast = prune_diff, col_indices = col_indices),
          env = list(prune_freq = prune_freq, prune_diff = prune_diff)
        )
      )
    }

    # Apply pruning conditions.
    prune_list <- add_expr(
      prune_list,
      substitute(
        expr = pruned_result <- pruned_result %>% rtables::prune_table(keep_content_rows(row_condition))
      )
    )
  }

  y$prune <- bracket_expr(prune_list)

  # Start sort the pruned table.
  sort_list <- list()
  scorefun <- if (add_total) {
    substitute(
      expr = cont_n_onecol(length(levels(parent$arm_var)) + 1),
      env = list(
        parent = as.name(parentname),
        arm_var = as.name(arm_var)
      )
    )
  } else {
    quote(cont_n_allcols)
  }
  if (one_term) {
    term_var <- ifelse(is.null(hlt), llt, hlt)

    sort_list <- add_expr(
      sort_list,
      substitute(
        expr = {
          pruned_and_sorted_result <- pruned_result %>%
            sort_at_path(path = term_var, scorefun = scorefun, decreasing = TRUE)
          pruned_and_sorted_result
        },
        env = list(
          term_var = term_var,
          scorefun = scorefun
        )
      )
    )
  } else {
    sort_list <- add_expr(
      sort_list,
      substitute(
        expr = {
          pruned_and_sorted_result <- pruned_result %>%
            sort_at_path(path = hlt, scorefun = scorefun, decreasing = TRUE) %>%
            sort_at_path(path = c(hlt, "*", llt), scorefun = scorefun, decreasing = TRUE)
        },
        env = list(
          llt = llt,
          hlt = hlt,
          scorefun = scorefun
        )
      )
    )

    sort_list <- add_expr(
      sort_list,
      quote(pruned_and_sorted_result)
    )
  }
  y$sort <- bracket_expr(sort_list)

  y
}

#' Template: Adverse Events Grouped by Grade with Threshold
#'
#' Creates a valid expression to generate a table to summarize adverse events grouped by grade.
#'
#' @inheritParams template_arguments
#' @param id (`character`)\cr name of variable to uniquely identify patients in datasets.
#' @param grade (`character`)\cr name of grade variable to base `grading_groups` on.
#' @param label_grade (`character`)\cr label of the `grade` variable from `dataname`.
#' @param grading_groups (`list`)\cr named list of grading groups.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_events_by_grade()]
#' @keywords internal
#'
template_events_col_by_grade <- function(dataname,
                                         parentname,
                                         arm_var,
                                         grading_groups = list(
                                           "Any Grade (%)" = c("1", "2", "3", "4", "5"),
                                           "Grade 1-2 (%)" = c("1", "2"),
                                           "Grade 3-4 (%)" = c("3", "4"),
                                           "Grade 5 (%)" = "5"
                                         ),
                                         add_total = TRUE,
                                         total_label = default_total_label(),
                                         id = "USUBJID",
                                         hlt,
                                         llt,
                                         label_hlt = NULL,
                                         label_llt = NULL,
                                         grade = "AETOXGR",
                                         label_grade = NULL,
                                         prune_freq = 0.1,
                                         prune_diff = 0,
                                         na_level = default_na_str(),
                                         drop_arm_levels = TRUE,
                                         basic_table_args = teal.widgets::basic_table_args()) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(arm_var)
  checkmate::assert_list(grading_groups)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_string(id)
  checkmate::assert_string(hlt, null.ok = TRUE)
  checkmate::assert_string(llt)
  checkmate::assert_string(grade)
  checkmate::assert_string(label_hlt, null.ok = TRUE)
  checkmate::assert_string(label_llt, null.ok = TRUE)
  checkmate::assert_string(label_grade, null.ok = TRUE)
  checkmate::assert_string(na_level)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_scalar(prune_freq)
  checkmate::assert_scalar(prune_diff)

  y <- list()

  # Start data steps.
  data_list <- list()

  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl <- df,
      env = list(df = as.name(dataname))
    )
  )

  data_list <- add_expr(
    data_list,
    prepare_arm_levels(
      dataname = "anl",
      parentname = parentname,
      arm_var = arm_var,
      drop_arm_levels = drop_arm_levels
    )
  )

  ## add_total for patients grouping across all arms
  if (add_total) {
    data_list <- add_expr(
      data_list,
      substitute(
        col_counts <- rep(c(table(parentname[[arm_var]]), nrow(parentname)), each = length(grading_groups)),
        env = list(parentname = as.name(parentname), grading_groups = grading_groups, arm_var = arm_var)
      )
    )
  } else {
    data_list <- add_expr(
      data_list,
      substitute(
        col_counts <- rep(table(parentname[[arm_var]]), each = length(grading_groups)),
        env = list(parentname = as.name(parentname), grading_groups = grading_groups, arm_var = arm_var)
      )
    )
  }

  data_pipe <- list()
  if (!is.null(hlt)) {
    data_pipe <- add_expr(
      data_pipe,
      substitute(
        expr = anl <- anl %>% dplyr::group_by(id, arm_var, hlt, llt),
        env = list(id = as.name(id), arm_var = as.name(arm_var), hlt = as.name(hlt), llt = as.name(llt))
      )
    )
  } else {
    data_pipe <- add_expr(
      data_pipe,
      substitute(
        expr = anl <- anl %>% dplyr::group_by(id, arm_var, llt),
        env = list(id = as.name(id), arm_var = as.name(arm_var), llt = as.name(llt))
      )
    )
  }

  data_pipe <- add_expr(
    data_pipe,
    substitute(
      expr = dplyr::summarize(MAXAETOXGR = factor(max(as.numeric(grade)))),
      env = list(grade = as.name(grade))
    )
  )
  data_pipe <- add_expr(
    data_pipe,
    quote(dplyr::ungroup())
  )
  data_pipe <- add_expr(
    data_pipe,
    substitute(
      expr = df_explicit_na(na_level = na_str),
      env = list(na_str = na_level)
    )
  )
  data_pipe <- pipe_expr(data_pipe)
  data_list <- add_expr(
    data_list,
    data_pipe
  )
  y$data <- bracket_expr(data_list)

  layout_list <- list()
  basic_title <- if (is.null(hlt) && !is.null(llt)) {
    paste0("Adverse Event summary by ", label_grade, ": ", label_llt)
  } else if (!is.null(hlt) && is.null(llt)) {
    paste0("Adverse Event summary by ", label_grade, ": ", label_hlt)
  } else if (!is.null(hlt) && !is.null(llt)) {
    paste0("Adverse Event summary by ", label_grade, ": ", label_hlt, " and ", label_llt)
  } else {
    paste0("Adverse Event summary by ", label_grade)
  }


  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(title = basic_title)
    )
  )

  # Start layout steps.
  layout_list <- list()
  layout_list <- add_expr(
    layout_list,
    parsed_basic_table_args
  )

  if (add_total) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = rtables::split_cols_by(var = arm_var, split_fun = add_overall_level(total_label, first = FALSE)),
        env = list(
          arm_var = arm_var,
          total_label = total_label
        )
      )
    )
  } else {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = rtables::split_cols_by(var = arm_var),
        env = list(arm_var = arm_var)
      )
    )
  }

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = split_cols_by_groups("MAXAETOXGR", groups = grading_groups),
      env = list(grading_groups = grading_groups)
    )
  )

  if (!is.null(hlt)) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = rtables::split_rows_by(
          hlt,
          child_labels = "visible",
          nested = FALSE,
          split_fun = trim_levels_in_group(llt)
        ),
        env = list(hlt = hlt, llt = llt)
      )
    )

    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = append_varlabels(df = anl, vars = hlt),
        env = list(hlt = hlt)
      )
    )

    unique_label <- paste0("Total number of patients with at least one adverse event")
    layout_list <- add_expr(
      layout_list,
      substitute(
        summarize_num_patients(
          var = id,
          .stats = "unique",
          .labels = unique_label,
        ),
        env = list(id = id, unique_label = unique_label)
      )
    )
  }

  layout_list <- add_expr(
    layout_list,
    substitute(
      analyze_vars(
        llt,
        na.rm = FALSE,
        denom = "N_col",
        .stats = "count_fraction",
        .formats = c(count_fraction = format_fraction_threshold(0.01))
      ),
      env = list(llt = llt)
    )
  )

  if (is.null(hlt)) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = append_varlabels(df = anl, vars = llt),
        env = list(llt = llt)
      )
    )
  } else {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = append_varlabels(df = anl, vars = llt, indent = 1L),
        env = list(llt = llt)
      )
    )
  }

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  # Full table.
  y$table <- quote(result <- rtables::build_table(lyt = lyt, df = anl, col_counts = col_counts))

  # Start sorting table.
  sort_list <- list()

  sort_list <- add_expr(
    sort_list,
    substitute(
      expr = lengths <- lapply(grading_groups, length),
      env = list(grading_groups = grading_groups)
    )
  )
  sort_list <- add_expr(
    sort_list,
    quote(start_index <- unname(which.max(lengths)))
  )
  sort_list <- add_expr(
    sort_list,
    substitute(
      expr = col_indices <- seq(start_index, ncol(result), by = length(grading_groups)),
      env = list(grading_groups = grading_groups)
    )
  )

  if (!is.null(hlt)) {
    sort_list <- add_expr(
      sort_list,
      quote(scorefun_soc <- score_occurrences_cont_cols(col_indices = col_indices))
    )
  }

  sort_list <- add_expr(
    sort_list,
    quote(scorefun_term <- score_occurrences_cols(col_indices = col_indices))
  )

  if (is.null(hlt)) {
    sort_list <- add_expr(
      sort_list,
      substitute(
        expr = {
          sorted_result <- result %>%
            sort_at_path(path = c(llt), scorefun = scorefun_term, decreasing = TRUE)
        },
        env = list(llt = llt)
      )
    )
  } else {
    sort_list <- add_expr(
      sort_list,
      substitute(
        expr = {
          sorted_result <- result %>%
            sort_at_path(path = c(hlt), scorefun = scorefun_soc, decreasing = TRUE) %>%
            sort_at_path(path = c(hlt, "*", llt), scorefun = scorefun_term, decreasing = TRUE)
        },
        env = list(
          hlt = hlt,
          llt = llt
        )
      )
    )
  }

  y$sort <- bracket_expr(sort_list)

  # Start pruning table.
  prune_list <- list()
  prune_list <- add_expr(
    prune_list,
    quote(
      criteria_fun <- function(tr) {
        inherits(tr, "ContentRow")
      }
    )
  )

  if (prune_freq > 0) {
    prune_list <- add_expr(
      prune_list,
      substitute(
        expr = at_least_percent_any <- has_fraction_in_any_col(atleast = prune_freq, col_indices = col_indices),
        env = list(prune_freq = prune_freq)
      )
    )
  }

  if (prune_diff > 0) {
    prune_list <- add_expr(
      prune_list,
      substitute(
        expr = at_least_percent_diff <- has_fractions_difference(atleast = prune_diff, col_indices = col_indices),
        env = list(prune_diff = prune_diff)
      )
    )
  }

  prune_pipe <- list()
  prune_pipe <- add_expr(
    prune_pipe,
    quote(
      pruned_and_sorted_result <- sorted_result %>% rtables::trim_rows(criteria = criteria_fun)
    )
  )

  if (prune_freq > 0 && prune_diff > 0) {
    prune_pipe <- add_expr(
      prune_pipe,
      quote(rtables::prune_table(keep_rows(at_least_percent_any & at_least_percent_diff)))
    )
  } else if (prune_freq > 0 && prune_diff == 0) {
    prune_pipe <- add_expr(
      prune_pipe,
      quote(rtables::prune_table(keep_rows(at_least_percent_any)))
    )
  } else if (prune_freq == 0 && prune_diff > 0) {
    prune_pipe <- add_expr(
      prune_pipe,
      quote(rtables::prune_table(keep_rows(at_least_percent_diff)))
    )
  } else {
    prune_pipe <- add_expr(
      prune_pipe,
      quote(rtables::prune_table())
    )
  }
  prune_pipe <- pipe_expr(prune_pipe)
  prune_list <- add_expr(
    prune_list,
    prune_pipe
  )
  prune_list <- add_expr(
    prune_list,
    quote(pruned_and_sorted_result)
  )

  y$prune <- bracket_expr(prune_list)

  y
}

#' teal Module: Events by Grade
#'
#' This module produces a table to summarize events by grade.
#'
#' @inheritParams module_arguments
#' @inheritParams template_events_by_grade
#' @inheritParams template_events_col_by_grade
#' @param col_by_grade (`logical`)\cr whether to display the grading groups in nested columns.
#' @param grading_groups (`list`)\cr named list of grading groups used when `col_by_grade = TRUE`.
#'
#' @inherit module_arguments return seealso
#'
#' @export
#' @examples
#' data <- teal_data()
#' data <- within(data, {
#'   library(dplyr)
#'
#'   ADSL <- tmc_ex_adsl
#'   lbls_adae <- col_labels(tmc_ex_adae)
#'   ADAE <- tmc_ex_adae %>%
#'     mutate_if(is.character, as.factor) #' be certain of having factors
#'   col_labels(ADAE) <- lbls_adae
#' })
#'
#' datanames <- c("ADSL", "ADAE")
#' datanames(data) <- datanames
#' join_keys(data) <- default_cdisc_join_keys[datanames]
#'
#' app <- init(
#'   data = data,
#'   modules = modules(
#'     tm_t_events_by_grade(
#'       label = "Adverse Events by Grade Table",
#'       dataname = "ADAE",
#'       arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"),
#'       llt = choices_selected(
#'         choices = variable_choices(data[["ADAE"]], c("AETERM", "AEDECOD")),
#'         selected = c("AEDECOD")
#'       ),
#'       hlt = choices_selected(
#'         choices = variable_choices(data[["ADAE"]], c("AEBODSYS", "AESOC")),
#'         selected = "AEBODSYS"
#'       ),
#'       grade = choices_selected(
#'         choices = variable_choices(data[["ADAE"]], c("AETOXGR", "AESEV")),
#'         selected = "AETOXGR"
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
tm_t_events_by_grade <- function(label,
                                 dataname,
                                 parentname = ifelse(
                                   inherits(arm_var, "data_extract_spec"),
                                   teal.transform::datanames_input(arm_var),
                                   "ADSL"
                                 ),
                                 arm_var,
                                 hlt,
                                 llt,
                                 grade,
                                 grading_groups = list(
                                   "Any Grade (%)" = c("1", "2", "3", "4", "5"),
                                   "Grade 1-2 (%)" = c("1", "2"),
                                   "Grade 3-4 (%)" = c("3", "4"),
                                   "Grade 5 (%)" = "5"
                                 ),
                                 col_by_grade = FALSE,
                                 prune_freq = 0,
                                 prune_diff = 0,
                                 add_total = TRUE,
                                 total_label = default_total_label(),
                                 na_level = default_na_str(),
                                 drop_arm_levels = TRUE,
                                 pre_output = NULL,
                                 post_output = NULL,
                                 basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_events_by_grade")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(hlt, "choices_selected")
  checkmate::assert_class(llt, "choices_selected")
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_string(na_level)
  checkmate::assert_flag(col_by_grade)
  checkmate::assert_scalar(prune_freq)
  checkmate::assert_scalar(prune_diff)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  args <- as.list(environment())

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    hlt = cs_to_des_select(hlt, dataname = dataname),
    llt = cs_to_des_select(llt, dataname = dataname),
    grade = cs_to_des_select(grade, dataname = dataname)
  )

  module(
    label = label,
    server = srv_t_events_by_grade,
    ui = ui_t_events_by_grade,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        total_label = total_label,
        grading_groups = grading_groups,
        na_level = na_level,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_t_events_by_grade <- function(id, ...) {
  ns <- NS(id)
  a <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(a$arm_var, a$hlt, a$llt, a$grade)

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c("arm_var", "hlt", "llt", "grade")]),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("hlt"),
        label = "Event High Level Term",
        data_extract_spec = a$hlt,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("llt"),
        label = "Event Low Level Term",
        data_extract_spec = a$llt,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("grade"),
        label = "Event Grade",
        data_extract_spec = a$grade,
        is_single_dataset = is_single_dataset_value
      ),
      checkboxInput(
        ns("add_total"),
        "Add All Patients column",
        value = a$add_total
      ),
      checkboxInput(
        ns("col_by_grade"),
        "Display grade groupings in nested columns",
        value = a$col_by_grade
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional table settings",
          checkboxInput(
            ns("drop_arm_levels"),
            label = "Drop columns not in filtered analysis dataset",
            value = a$drop_arm_levels
          ),
          helpText("Pruning Options"),
          numericInput(
            inputId = ns("prune_freq"),
            label = "Minimum Incidence Rate(%) in any of the treatment groups",
            value = a$prune_freq,
            min = 0,
            max = 100,
            step = 1,
            width = "100%"
          ),
          numericInput(
            inputId = ns("prune_diff"),
            label = "Minimum Difference Rate(%) between any of the treatment groups",
            value = a$prune_diff,
            min = 0,
            max = 100,
            step = 1,
            width = "100%"
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_t_events_by_grade <- function(id,
                                  data,
                                  reporter,
                                  filter_panel_api,
                                  dataname,
                                  parentname,
                                  label,
                                  arm_var,
                                  hlt,
                                  llt,
                                  grade,
                                  col_by_grade,
                                  grading_groups,
                                  drop_arm_levels,
                                  total_label,
                                  na_level,
                                  basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(arm_var = arm_var, hlt = hlt, llt = llt, grade = grade),
      datasets = data,
      select_validation_rule = list(
        arm_var = shinyvalidate::sv_required("A treatment variable is required"),
        grade = shinyvalidate::sv_required("An event grade is required"),
        hlt = ~ if (length(selector_list()$llt()$select) + length(.) == 0) {
          "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables."
        },
        llt = shinyvalidate::compose_rules(
          ~ if (length(selector_list()$hlt()$select) + length(.) == 0) {
            "Please select at least one of \"LOW LEVEL TERM\" or \"HIGH LEVEL TERM\" variables."
          },
          ~ if (col_by_grade() && length(.) == 0) {
            "Low Level Term must be present when grade groupings are displayed in nested columns."
          }
        )
      )
    )

    col_by_grade <- reactive({
      input$col_by_grade
    })

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule(
        "prune_freq", shinyvalidate::sv_required("Please provide an Incidence Rate between 0 and 100 (%).")
      )
      iv$add_rule(
        "prune_freq",
        shinyvalidate::sv_between(0, 100, message_fmt = "Please provide an Incidence Rate between 0 and 100 (%).")
      )
      iv$add_rule(
        "prune_diff", shinyvalidate::sv_required("Please provide a Difference Rate between 0 and 100 (%).")
      )
      iv$add_rule(
        "prune_diff",
        shinyvalidate::sv_between(0, 100, message_fmt = "Please provide a Difference Rate between 0 and 100 (%).")
      )
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    validate_checks <- reactive({
      teal::validate_inputs(iv_r())

      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]
      adsl_keys <- merged$adsl_input_r()$keys

      checkmate::assert(
        .var.name = "adsl_keys",
        if ("USUBJID" %in% adsl_keys) TRUE else "Must contain \"USUBJID\""
      )

      input_arm_var <- as.vector(merged$anl_input_r()$columns_source$arm_var)
      input_level_term <- c(
        as.vector(merged$anl_input_r()$columns_source$hlt),
        as.vector(merged$anl_input_r()$columns_source$llt)
      )
      input_grade <- as.vector(merged$anl_input_r()$columns_source$grade)

      validate(
        need(is.factor(adsl_filtered[[input_arm_var]]), "Treatment variable is not a factor.")
      )
      if (input$col_by_grade) {
        validate(
          need(
            is.factor(anl_filtered[[input_grade]]) &&
              all(as.character(unique(anl_filtered[[input_grade]])) %in% as.character(c(1:5))),
            paste(
              "Data includes records with grade levels outside of 1-5.",
              "Please use filter panel to exclude from analysis in order to display grade grouping in nested columns."
            )
          )
        )
      } else {
        validate(
          need(
            is.factor(anl_filtered[[input_grade]]),
            "Event grade variable must be a factor."
          )
        )
      }

      # validate inputs
      validate_standard_inputs(
        adsl = adsl_filtered,
        adslvars = c(adsl_keys, input_arm_var),
        anl = anl_filtered,
        anlvars = c(adsl_keys, input_level_term, input_grade),
        arm_var = input_arm_var
      )
    })

    # The R-code corresponding to the analysis.
    table_q <- reactive({
      validate_checks()
      ANL <- merged$anl_q()[["ANL"]]

      input_hlt <- as.vector(merged$anl_input_r()$columns_source$hlt)
      input_llt <- as.vector(merged$anl_input_r()$columns_source$llt)
      input_grade <- as.vector(merged$anl_input_r()$columns_source$grade)
      label_hlt <- if (length(input_hlt) != 0) attributes(ANL[[input_hlt]])$label else NULL
      label_llt <- if (length(input_llt) != 0) attributes(ANL[[input_llt]])$label else NULL
      label_grade <- if (length(input_grade) != 0) attributes(ANL[[input_grade]])$label else NULL
      label_grade <- if (is.null(label_grade)) input_grade else NULL

      my_calls <- if (input$col_by_grade) {
        template_events_col_by_grade(
          dataname = "ANL",
          parentname = "ANL_ADSL",
          add_total = input$add_total,
          total_label = total_label,
          grading_groups = grading_groups,
          arm_var = as.vector(merged$anl_input_r()$columns_source$arm_var),
          id = "USUBJID",
          hlt = if (length(input_hlt) != 0) input_hlt else NULL,
          llt = if (length(input_llt) != 0) input_llt else NULL,
          label_hlt = label_hlt,
          label_llt = label_llt,
          grade = if (length(input_grade) != 0) input_grade else NULL,
          label_grade = label_grade,
          prune_freq = input$prune_freq / 100,
          prune_diff = input$prune_diff / 100,
          na_level = na_level,
          drop_arm_levels = input$drop_arm_levels,
          basic_table_args = basic_table_args
        )
      } else {
        template_events_by_grade(
          dataname = "ANL",
          parentname = "ANL_ADSL",
          arm_var = as.vector(merged$anl_input_r()$columns_source$arm_var),
          id = "USUBJID",
          hlt = if (length(input_hlt) != 0) input_hlt else NULL,
          llt = if (length(input_llt) != 0) input_llt else NULL,
          label_hlt = label_hlt,
          label_llt = label_llt,
          grade = input_grade,
          label_grade = label_grade,
          prune_freq = input$prune_freq / 100,
          prune_diff = input$prune_diff / 100,
          add_total = input$add_total,
          total_label = total_label,
          na_level = na_level,
          drop_arm_levels = input$drop_arm_levels,
          basic_table_args = basic_table_args
        )
      }
      teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
    })

    # Outputs to render.
    table_r <- reactive({
      table_q()[["pruned_and_sorted_result"]]
    })

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    # Render R code.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(table_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Events by Grade Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(table_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Patient Profile Laboratory Table
#'
#' Creates a valid expression to generate a patient profile laboratory table using ADaM datasets.
#'
#' @inheritParams template_arguments
#' @param paramcd (`character`)\cr name of the parameter code variable.
#' @param param (`character`)\cr name of the parameter variable.
#' @param timepoints (`character`)\cr name of time variable.
#' @param anrind (`character`)\cr name of the analysis reference range indicator variable.
#' @param round_value (`numeric`)\cr number of decimal places to round to.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_pp_laboratory()]
#'
#' @keywords internal
template_laboratory <- function(dataname = "ANL",
                                paramcd = "PARAMCD",
                                param = "PARAM",
                                anrind = "ANRIND",
                                timepoints = "ADY",
                                aval = lifecycle::deprecated(),
                                aval_var = "AVAL",
                                avalu = lifecycle::deprecated(),
                                avalu_var = "AVALU",
                                patient_id = NULL,
                                round_value = 0L) {
  if (lifecycle::is_present(aval)) {
    aval_var <- aval
    warning(
      "The `aval` argument of `template_laboratory()` is deprecated as of teal.modules.clinical 0.8.16. ",
      "Please use the `aval_var` argument instead.",
      call. = FALSE
    )
  }

  if (lifecycle::is_present(avalu)) {
    avalu_var <- avalu
    warning(
      "The `avalu` argument of `template_laboratory()` is deprecated as of teal.modules.clinical 0.8.16. ",
      "Please use the `avalu_var` argument instead.",
      call. = FALSE
    )
  }

  checkmate::assert_string(dataname)
  checkmate::assert_string(paramcd)
  checkmate::assert_string(param)
  checkmate::assert_string(anrind)
  checkmate::assert_string(timepoints)
  checkmate::assert_string(aval_var)
  checkmate::assert_string(avalu_var)
  checkmate::assert_integer(round_value, lower = 0)

  y <- list()
  y$table <- list()

  table_lab_list <- add_expr(
    list(),
    substitute(
      expr = {
        dataname[, aval_char] <- round(dataname[, aval_char], round_value)
        labor_table_base <- dataname %>%
          dplyr::select(timepoints, paramcd, param, aval_var, avalu_var, anrind) %>%
          dplyr::arrange(timepoints) %>%
          dplyr::select(-timepoints) %>%
          dplyr::group_by(paramcd, param) %>%
          dplyr::mutate(INDEX = dplyr::row_number()) %>%
          dplyr::ungroup() %>%
          dplyr::mutate(aval_anrind = paste(aval_var, anrind)) %>%
          dplyr::select(-c(aval_var, anrind))

        labor_table_raw <- labor_table_base %>%
          as.data.frame() %>%
          stats::reshape(
            direction = "wide",
            idvar = c(paramcd_char, param_char, avalu_char),
            v.names = "aval_anrind",
            timevar = "INDEX"
          )
        colnames(labor_table_raw)[-c(1:3)] <- unique(labor_table_base$INDEX)

        labor_table_raw[[param_char]] <- clean_description(labor_table_raw[[param_char]])

        labor_table_raw <- rlistings::as_listing(
          labor_table_raw,
          key_cols = NULL,
          default_formatting = list(all = fmt_config(align = "left"))
        )
        main_title(labor_table_raw) <- paste("Patient ID:", patient_id)

        labor_table_html <- labor_table_base %>%
          dplyr::mutate(aval_anrind_col = color_lab_values(aval_anrind)) %>%
          dplyr::select(-aval_anrind) %>%
          as.data.frame() %>%
          stats::reshape(
            direction = "wide",
            idvar = c(paramcd_char, param_char, avalu_char),
            v.names = "aval_anrind_col",
            timevar = "INDEX"
          )
        colnames(labor_table_html)[-c(1:3)] <- unique(labor_table_base$INDEX)
        labor_table_html[[param_char]] <- clean_description(labor_table_html[[param_char]])

        labor_table_html_dt <- DT::datatable(labor_table_html, escape = FALSE)
        labor_table_html_dt$dependencies <- c(
          labor_table_html_dt$dependencies,
          list(rmarkdown::html_dependency_bootstrap("default"))
        )
        labor_table_html_dt
      },
      env = list(
        dataname = as.name(dataname),
        param = as.name(param),
        param_char = param,
        paramcd = as.name(paramcd),
        paramcd_char = paramcd,
        aval_var = as.name(aval_var),
        aval_char = aval_var,
        avalu_var = as.name(avalu_var),
        avalu_char = avalu_var,
        timepoints = as.name(timepoints),
        anrind = as.name(anrind),
        patient_id = patient_id,
        round_value = round_value
      )
    )
  )

  y$table <- bracket_expr(table_lab_list)
  y
}

#' teal Module: Patient Profile Laboratory Table
#'
#' This module produces a patient profile laboratory table using ADaM datasets.
#'
#' @inheritParams module_arguments
#' @inheritParams template_laboratory
#' @param param ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `PARAM` variable from `dataname`.
#' @param timepoints ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the time variable from `dataname`.
#' @param anrind ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `ANRIND` variable from `dataname`. Variable should have the
#'   following 3 levels: `"HIGH"`, `"LOW"`, and `"NORMAL"`.
#'
#' @inherit module_arguments return
#'
#' @examples
#' ADSL <- tmc_ex_adsl
#' ADLB <- tmc_ex_adlb
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADLB = ADLB,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADLB <- tmc_ex_adlb
#'     "
#'   ),
#'   modules = modules(
#'     tm_t_pp_laboratory(
#'       label = "Vitals",
#'       dataname = "ADLB",
#'       patient_col = "USUBJID",
#'       paramcd = choices_selected(
#'         choices = variable_choices(ADLB, "PARAMCD"),
#'         selected = "PARAMCD"
#'       ),
#'       param = choices_selected(
#'         choices = variable_choices(ADLB, "PARAM"),
#'         selected = "PARAM"
#'       ),
#'       timepoints = choices_selected(
#'         choices = variable_choices(ADLB, "ADY"),
#'         selected = "ADY"
#'       ),
#'       anrind = choices_selected(
#'         choices = variable_choices(ADLB, "ANRIND"),
#'         selected = "ANRIND"
#'       ),
#'       aval_var = choices_selected(
#'         choices = variable_choices(ADLB, "AVAL"),
#'         selected = "AVAL"
#'       ),
#'       avalu_var = choices_selected(
#'         choices = variable_choices(ADLB, "AVALU"),
#'         selected = "AVALU"
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_pp_laboratory <- function(label,
                               dataname = "ADLB",
                               parentname = "ADSL",
                               patient_col = "USUBJID",
                               timepoints = NULL,
                               aval = lifecycle::deprecated(),
                               aval_var = NULL,
                               avalu = lifecycle::deprecated(),
                               avalu_var = NULL,
                               param = NULL,
                               paramcd = NULL,
                               anrind = NULL,
                               pre_output = NULL,
                               post_output = NULL) {
  if (lifecycle::is_present(aval)) {
    aval_var <- aval
    warning(
      "The `aval` argument of `tm_t_pp_laboratory()` is deprecated as of teal.modules.clinical 0.8.16. ",
      "Please use the `aval_var` argument instead.",
      call. = FALSE
    )
  } else {
    aval <- aval_var # resolves missing argument error
  }

  if (lifecycle::is_present(avalu)) {
    avalu_var <- avalu
    warning(
      "The `avalu` argument of `tm_t_pp_laboratory()` is deprecated as of teal.modules.clinical 0.8.16. ",
      "Please use the `avalu_var` argument instead.",
      call. = FALSE
    )
  } else {
    avalu <- avalu_var # resolves missing argument error
  }

  message("Initializing tm_t_pp_laboratory")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(patient_col)
  checkmate::assert_class(timepoints, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(aval_var, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(avalu_var, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(param, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(paramcd, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(anrind, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)

  args <- as.list(environment())
  data_extract_list <- list(
    timepoints = `if`(is.null(timepoints), NULL, cs_to_des_select(timepoints, dataname = dataname)),
    aval_var = `if`(is.null(aval_var), NULL, cs_to_des_select(aval_var, dataname = dataname)),
    avalu_var = `if`(is.null(avalu_var), NULL, cs_to_des_select(avalu_var, dataname = dataname)),
    param = `if`(is.null(param), NULL, cs_to_des_select(param, dataname = dataname)),
    paramcd = `if`(is.null(paramcd), NULL, cs_to_des_select(paramcd, dataname = dataname)),
    anrind = `if`(is.null(anrind), NULL, cs_to_des_select(anrind, dataname = dataname))
  )

  module(
    label = label,
    ui = ui_g_laboratory,
    ui_args = c(data_extract_list, args),
    server = srv_g_laboratory,
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        patient_col = patient_col
      )
    ),
    datanames = c(dataname, parentname)
  )
}

#' @keywords internal
ui_g_laboratory <- function(id, ...) {
  ui_args <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    ui_args$timepoints,
    ui_args$aval_var,
    ui_args$avalu_var,
    ui_args$param,
    ui_args$paramcd,
    ui_args$anrind
  )

  ns <- NS(id)
  teal.widgets::standard_layout(
    output = tags$div(
      htmlOutput(ns("title")),
      DT::DTOutput(outputId = ns("lab_values_table"))
    ),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(ui_args[c("timepoints", "aval_var", "avalu_var", "param", "paramcd", "anrind")]),
      teal.widgets::optionalSelectInput(
        ns("patient_id"),
        "Select Patient:",
        multiple = FALSE,
        options = shinyWidgets::pickerOptions(`liveSearch` = TRUE)
      ),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select PARAMCD variable:",
        data_extract_spec = ui_args$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("param"),
        label = "Select PARAM variable:",
        data_extract_spec = ui_args$param,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("timepoints"),
        label = "Select timepoints variable:",
        data_extract_spec = ui_args$timepoints,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("aval_var"),
        label = "Select AVAL variable:",
        data_extract_spec = ui_args$aval_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("avalu_var"),
        label = "Select AVALU variable:",
        data_extract_spec = ui_args$avalu_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("anrind"),
        label = "Select ANRIND variable:",
        data_extract_spec = ui_args$anrind,
        is_single_dataset = is_single_dataset_value
      ),
      selectInput(
        inputId = ns("round_value"),
        label = "Select number of decimal places for rounding:",
        choices = NULL
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = ui_args$pre_output,
    post_output = ui_args$post_output
  )
}

#' @keywords internal
srv_g_laboratory <- function(id,
                             data,
                             reporter,
                             filter_panel_api,
                             dataname,
                             parentname,
                             patient_col,
                             timepoints,
                             aval_var,
                             avalu_var,
                             param,
                             paramcd,
                             anrind,
                             label) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    patient_id <- reactive(input$patient_id)

    # Init
    patient_data_base <- reactive(unique(data()[[parentname]][[patient_col]]))
    teal.widgets::updateOptionalSelectInput(
      session,
      "patient_id",
      choices = patient_data_base(),
      selected = patient_data_base()[1]
    )

    observeEvent(patient_data_base(),
      handlerExpr = {
        teal.widgets::updateOptionalSelectInput(
          session,
          "patient_id",
          choices = patient_data_base(),
          selected = if (length(patient_data_base()) == 1) {
            patient_data_base()
          } else {
            intersect(patient_id(), patient_data_base())
          }
        )
      },
      ignoreInit = TRUE
    )

    # Update round_values
    aval_values <- isolate(data())[[dataname]][, aval_var$select$selected]
    decimal_nums <- aval_values[trunc(aval_values) != aval_values]
    max_decimal <- max(nchar(gsub("([0-9]+).([0-9]+)", "\\2", decimal_nums)))

    updateSelectInput(
      session,
      "round_value",
      choices = seq(0, max_decimal),
      selected = min(4, max_decimal)
    )

    # Laboratory values tab ----
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        timepoints = timepoints,
        aval_var = aval_var,
        avalu_var = avalu_var,
        param = param,
        paramcd = paramcd,
        anrind = anrind
      ),
      datasets = data,
      select_validation_rule = list(
        timepoints = shinyvalidate::sv_required("Please select timepoints variable."),
        aval_var = shinyvalidate::sv_required("Please select AVAL variable."),
        avalu_var = shinyvalidate::sv_required("Please select AVALU variable."),
        param = shinyvalidate::sv_required("Please select PARAM variable."),
        paramcd = shinyvalidate::sv_required("Please select PARAMCD variable."),
        anrind = shinyvalidate::sv_required("Please select ANRIND variable.")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient"))
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr))
    })

    all_q <- reactive({
      teal::validate_inputs(iv_r())

      labor_calls <- template_laboratory(
        dataname = "ANL",
        timepoints = input[[extract_input("timepoints", dataname)]],
        aval_var = input[[extract_input("aval_var", dataname)]],
        avalu_var = input[[extract_input("avalu_var", dataname)]],
        param = input[[extract_input("param", dataname)]],
        paramcd = input[[extract_input("paramcd", dataname)]],
        anrind = input[[extract_input("anrind", dataname)]],
        patient_id = patient_id(),
        round_value = as.integer(input$round_value)
      )

      teal.code::eval_code(
        anl_q(),
        substitute(
          expr = {
            pt_id <- patient_id
            ANL <- ANL[ANL[[patient_col]] == patient_id, ]
          }, env = list(
            patient_col = patient_col,
            patient_id = patient_id()
          )
        )
      ) %>%
        teal.code::eval_code(as.expression(labor_calls))
    })

    output$title <- renderText({
      paste("<h5><b>Patient ID:", all_q()[["pt_id"]], "</b></h5>")
    })

    table_r <- reactive({
      q <- all_q()
      list(
        html = q[["labor_table_html"]],
        raw = q[["labor_table_raw"]]
      )
    })

    output$lab_values_table <- DT::renderDataTable(
      expr = table_r()$html,
      escape = FALSE,
      options = list(
        lengthMenu = list(list(-1, 5, 10, 25), list("All", "5", "10", "25")),
        scrollX = TRUE
      )
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Patient Profile Laboratory Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r()$raw)
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Summary of Variables
#'
#' Creates a valid expression to generate a table to summarize variables.
#'
#' @inheritParams template_arguments
#' @param show_labels `r lifecycle::badge("deprecated")`
#' @param arm_var_labels (`character` or `NULL`)\cr vector of column variable labels to display, of the same length as
#'   `arm_var`. If `NULL`, no labels will be displayed.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_summary()]
#'
#' @keywords internal
template_summary <- function(dataname,
                             parentname,
                             arm_var,
                             sum_vars,
                             show_labels = lifecycle::deprecated(),
                             add_total = TRUE,
                             total_label = default_total_label(),
                             var_labels = character(),
                             arm_var_labels = NULL,
                             na.rm = FALSE, # nolint: object_name.
                             na_level = default_na_str(),
                             numeric_stats = c(
                               "n", "mean_sd", "mean_ci", "median", "median_ci", "quantiles", "range", "geom_mean"
                             ),
                             denominator = c("N", "n", "omit"),
                             drop_arm_levels = TRUE,
                             basic_table_args = teal.widgets::basic_table_args()) {
  if (lifecycle::is_present(show_labels)) {
    warning(
      "The `show_labels` argument of `template_summary` is deprecated as of teal.modules.clinical 0.9.1.9013 ",
      "as it is has no effect on the module.",
      call. = FALSE
    )
  }

  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_character(arm_var, min.len = 1, max.len = 2)
  checkmate::assert_character(sum_vars)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_character(var_labels)
  checkmate::assert_character(arm_var_labels, len = length(arm_var), null.ok = TRUE)
  checkmate::assert_flag(na.rm)
  checkmate::assert_string(na_level)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_character(numeric_stats, min.len = 1)
  checkmate::assert_subset(
    numeric_stats,
    c("n", "mean_sd", "mean_ci", "median", "median_ci", "quantiles", "range", "geom_mean")
  )

  denominator <- match.arg(denominator)

  y <- list()

  # Data processing
  data_list <- list()

  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl <- df %>%
        df_explicit_na(omit_columns = setdiff(names(df), c(sum_vars)), na_level = na_str),
      env = list(
        df = as.name(dataname),
        sum_vars = sum_vars,
        na_str = na_level
      )
    )
  )

  prepare_arm_levels_call <- lapply(arm_var, function(x) {
    prepare_arm_levels(
      dataname = "anl",
      parentname = parentname,
      arm_var = x,
      drop_arm_levels = drop_arm_levels
    )
  })
  data_list <- Reduce(add_expr, prepare_arm_levels_call, init = data_list)

  data_list <- add_expr(
    data_list,
    substitute(
      expr = parentname <- df_explicit_na(parentname, na_level = na_str),
      env = list(
        parentname = as.name(parentname),
        na_str = na_level
      )
    )
  )

  y$data <- bracket_expr(data_list)

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(
        show_colcounts = TRUE,
        main_footer =
          "n represents the number of unique subject IDs such that the variable has non-NA values."
      )
    )
  )

  layout_list <- list()
  layout_list <- add_expr(
    layout_list,
    parsed_basic_table_args
  )

  # Build layout
  split_cols_call <- lapply(arm_var, function(x) {
    if (drop_arm_levels) {
      substitute(
        expr = rtables::split_cols_by(x, split_fun = drop_split_levels),
        env = list(x = x)
      )
    } else {
      substitute(
        expr = rtables::split_cols_by(x),
        env = list(x = x)
      )
    }
  })
  layout_list <- Reduce(add_expr, split_cols_call, init = layout_list)

  if (add_total) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = rtables::add_overall_col(total_label),
        env = list(total_label = total_label)
      )
    )
  }

  env_sum_vars <- list(
    sum_vars = sum_vars,
    sum_var_labels = var_labels[sum_vars],
    na.rm = na.rm,
    na_level = na_level,
    denom = ifelse(denominator == "n", "n", "N_col"),
    stats = c(
      numeric_stats,
      ifelse(denominator == "omit", "count", "count_fraction")
    )
  )

  layout_list <- add_expr(
    layout_list,
    if (length(var_labels) > 0) {
      substitute(
        expr = analyze_vars(
          vars = sum_vars,
          var_labels = sum_var_labels,
          show_labels = "visible",
          na.rm = na.rm,
          na_str = na_level,
          denom = denom,
          .stats = stats
        ),
        env = env_sum_vars
      )
    } else {
      substitute(
        expr = analyze_vars(
          vars = sum_vars,
          show_labels = "visible",
          na.rm = na.rm,
          na_str = na_level,
          denom = denom,
          .stats = stats
        ),
        env = env_sum_vars
      )
    }
  )

  if (!is.null(arm_var_labels)) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = append_topleft(arm_var_labels),
        env = list(arm_var_labels = c(arm_var_labels, ""))
      )
    )
  }

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  y$table <- substitute(
    expr = {
      result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
      result
    },
    env = list(parent = as.name(parentname))
  )

  y
}

#' teal Module: Summary of Variables
#'
#' This module produces a table to summarize variables.
#'
#' @inheritParams module_arguments
#' @inheritParams template_summary
#' @param arm_var ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for variable names that can be used as `arm_var`.
#'   It defines the grouping variable(s) in the results table.
#'   If there are two elements selected for `arm_var`,
#'   second variable will be nested under the first variable.
#' @param show_arm_var_labels (`flag`)\cr whether arm variable label(s) should be displayed. Defaults to `TRUE`.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' # Preparation of the test case - use `EOSDY` and `DCSREAS` variables to demonstrate missing data.
#' ADSL <- tmc_ex_adsl
#' ADSL$EOSDY[1] <- NA_integer_
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADSL$EOSDY[1] <- NA_integer_
#'     "
#'   ),
#'   modules = modules(
#'     tm_t_summary(
#'       label = "Demographic Table",
#'       dataname = "ADSL",
#'       arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"),
#'       add_total = TRUE,
#'       summarize_vars = choices_selected(
#'         c("SEX", "RACE", "BMRKR2", "EOSDY", "DCSREAS", "AGE"),
#'         c("SEX", "RACE")
#'       ),
#'       useNA = "ifany"
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_summary <- function(label,
                         dataname,
                         parentname = ifelse(
                           inherits(arm_var, "data_extract_spec"),
                           teal.transform::datanames_input(arm_var),
                           "ADSL"
                         ),
                         arm_var,
                         summarize_vars,
                         add_total = TRUE,
                         total_label = default_total_label(),
                         show_arm_var_labels = TRUE,
                         useNA = c("ifany", "no"), # nolint: object_name.
                         na_level = default_na_str(),
                         numeric_stats = c(
                           "n", "mean_sd", "mean_ci", "median", "median_ci", "quantiles", "range", "geom_mean"
                         ),
                         denominator = c("N", "n", "omit"),
                         drop_arm_levels = TRUE,
                         pre_output = NULL,
                         post_output = NULL,
                         basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_summary")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(summarize_vars, "choices_selected")
  checkmate::assert_string(na_level)
  checkmate::assert_character(numeric_stats, min.len = 1)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")
  checkmate::assert_flag(add_total)
  checkmate::assert_flag(show_arm_var_labels)
  checkmate::assert_string(total_label)

  useNA <- match.arg(useNA) # nolint: object_name.
  denominator <- match.arg(denominator)
  numeric_stats <- match.arg(numeric_stats, several.ok = TRUE)

  args <- as.list(environment())

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname, multiple = TRUE, ordered = TRUE),
    summarize_vars = cs_to_des_select(summarize_vars, dataname = dataname, multiple = TRUE, ordered = TRUE)
  )

  module(
    label = label,
    server = srv_summary,
    ui = ui_summary,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        show_arm_var_labels = show_arm_var_labels,
        total_label = total_label,
        na_level = na_level,
        basic_table_args = basic_table_args
      )
    ),
    datanames = c(dataname, parentname)
  )
}

#' @keywords internal
ui_summary <- function(id, ...) {
  ns <- NS(id)
  a <- list(...)

  is_single_dataset_value <- teal.transform::is_single_dataset(a$arm_var, a$summarize_vars)

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c("arm_var", "summarize_vars")]),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Column Variable(s)",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      checkboxInput(ns("add_total"), "Add All Patients column", value = a$add_total),
      teal.transform::data_extract_ui(
        id = ns("summarize_vars"),
        label = "Summarize Variables",
        data_extract_spec = a$summarize_vars,
        is_single_dataset = is_single_dataset_value
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional table settings",
          radioButtons(
            ns("useNA"),
            label = "Display NA counts",
            choices = c("ifany", "no"),
            selected = a$useNA
          ),
          checkboxGroupInput(
            ns("numeric_stats"),
            label = "Choose the statistics to display for numeric variables",
            choices = c(
              "n" = "n",
              "Mean (SD)" = "mean_sd",
              "Mean 95% CI" = "mean_ci",
              "Geometric Mean" = "geom_mean",
              "Median" = "median",
              "Median 95% CI" = "median_ci",
              "25% and 75%-ile" = "quantiles",
              "Min - Max" = "range"
            ),
            selected = a$numeric_stats
          ),
          radioButtons(
            ns("denominator"),
            label = "Denominator choice",
            choices = c("N", "n", "omit"),
            selected = a$denominator
          ),
          if (a$dataname == a$parentname) {
            shinyjs::hidden(
              checkboxInput(
                ns("drop_arm_levels"),
                label = "it's a BUG if you see this",
                value = TRUE
              )
            )
          } else {
            checkboxInput(
              ns("drop_arm_levels"),
              label = sprintf("Drop columns not in filtered %s", a$dataname),
              value = a$drop_arm_levels
            )
          }
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_summary <- function(id,
                        data,
                        reporter,
                        filter_panel_api,
                        dataname,
                        parentname,
                        arm_var,
                        summarize_vars,
                        add_total,
                        show_arm_var_labels,
                        total_label,
                        na_level,
                        drop_arm_levels,
                        label,
                        basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")
  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(arm_var = arm_var, summarize_vars = summarize_vars),
      datasets = data,
      select_validation_rule = list(
        summarize_vars = shinyvalidate::sv_required("Please select a summarize variable"),
        arm_var = ~ if (length(.) != 1 && length(.) != 2) {
          "Please select 1 or 2 column variables"
        }
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("numeric_stats", shinyvalidate::sv_required("Please select at least one statistic to display."))
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      id = "anl_merge",
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      id = "adsl_merge",
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    observeEvent(merged$anl_input_r()$columns_source$summarize_vars, {
      choices_classes <- sapply(
        names(merged$anl_input_r()$columns_source$summarize_vars),
        function(x) {
          summarize_var_data <- data()[[summarize_vars$dataname]][[x]]
          inherits(summarize_var_data, "numeric") |
            inherits(summarize_var_data, "integer")
        }
      )

      if (any(choices_classes)) {
        shinyjs::show("numeric_stats")
      } else {
        shinyjs::hide("numeric_stats")
      }
    })

    # validate inputs
    validate_checks <- reactive({
      teal::validate_inputs(iv_r())
      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]
      anl <- merged$anl_q()[["ANL"]]

      # we take names of the columns source as they match names of the input data in merge_datasets
      # if we use $arm_var they might be renamed to <selector id>.arm_var
      input_arm_var <- names(merged$anl_input_r()$columns_source$arm_var)
      input_summarize_vars <- names(merged$anl_input_r()$columns_source$summarize_vars)

      validate(
        need(
          length(unique(anl$USUBJID)) == nrow(anl),
          paste0(
            "Please choose an analysis dataset where each row represents a different subject, ",
            "i.e. USUBJID is different in each row"
          )
        ),
        need(
          !any(vapply(anl_filtered[, input_summarize_vars], inherits, c("Date", "POSIXt"),
            FUN.VALUE = logical(1)
          )),
          "Date and POSIXt variables are not supported, please select other variables"
        ),
        if (length(input_arm_var) == 2) {
          need(
            is.factor(adsl_filtered[[input_arm_var[[2]]]]) & all(!adsl_filtered[[input_arm_var[[2]]]] %in% c("", NA)),
            "Please check nested treatment variable which needs to be a factor without NA or empty strings."
          )
        }
      )

      validate_standard_inputs(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_summarize_vars),
        arm_var = input_arm_var[[1]]
      )
    })

    # generate r code for the analysis
    all_q <- reactive({
      validate_checks()

      summarize_vars <- merged$anl_input_r()$columns_source$summarize_vars
      var_labels <- teal.data::col_labels(data()[[dataname]][, summarize_vars, drop = FALSE])

      arm_var_labels <- NULL
      if (show_arm_var_labels) {
        arm_vars <- merged$anl_input_r()$columns_source$arm_var
        arm_var_labels <- teal.data::col_labels(data()[[dataname]][, arm_vars, drop = FALSE], fill = TRUE)
      }

      my_calls <- template_summary(
        dataname = "ANL",
        parentname = "ANL_ADSL",
        arm_var = merged$anl_input_r()$columns_source$arm_var,
        sum_vars = summarize_vars,
        add_total = input$add_total,
        total_label = total_label,
        var_labels = var_labels,
        arm_var_labels = arm_var_labels,
        na.rm = ifelse(input$useNA == "ifany", FALSE, TRUE),
        na_level = na_level,
        numeric_stats = input$numeric_stats,
        denominator = input$denominator,
        drop_arm_levels = input$drop_arm_levels,
        basic_table_args = basic_table_args
      )

      teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
    })

    # Outputs to render.
    table_r <- reactive(all_q()[["result"]])
    teal.widgets::table_with_settings_srv(id = "table", table_r = table_r)

    # Render R code.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Summary Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template for Generalized Estimating Equations (GEE) analysis module
#'
#' Creates a valid expression to generate an analysis table using Generalized Estimating Equations (GEE).
#'
#' @inheritParams template_arguments
#' @param output_table (`character`)\cr type of output table (`"t_gee_cov", "t_gee_coef", "t_gee_lsmeans"`).
#' @param data_model_fit (`character`)\cr dataset used to fit the model by `tern.gee::fit_gee()`.
#' @param dataname_lsmeans (`character`)\cr dataset used for `alt_counts_df` argument of `rtables::build_table()`.
#' @param split_covariates (`character`)\cr vector of names of variables to use as covariates in
#'   `tern.gee::vars_gee()`.
#' @param cor_struct (`character`)\cr assumed correlation structure in `tern.gee::fit_gee`.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_a_gee()]
#'
#' @keywords internal
template_a_gee <- function(output_table,
                           data_model_fit = "ANL",
                           dataname_lsmeans = "ANL_ADSL",
                           input_arm_var = "ARM",
                           ref_group = "A: Drug X",
                           aval_var,
                           id_var,
                           arm_var,
                           visit_var,
                           split_covariates,
                           cor_struct,
                           conf_level = 0.95,
                           basic_table_args = teal.widgets::basic_table_args()) {
  y <- list()
  y$model <- list()
  y$table <- list()

  all_basic_table_args <- teal.widgets::resolve_basic_table_args(basic_table_args)

  model_list <- add_expr(
    list(),
    substitute(
      expr = {
        model_fit <- tern.gee::fit_gee(
          vars = tern.gee::vars_gee(
            response = as.vector(aval_var),
            covariates = as.vector(split_covariates),
            id = as.vector(id_var),
            arm = as.vector(arm_var),
            visit = as.vector(visit_var)
          ),
          data = data_model_fit,
          regression = "logistic",
          cor_struct = cor_struct
        )
      },
      env = list(
        data_model_fit = as.name(data_model_fit),
        aval_var = aval_var,
        split_covariates = split_covariates,
        id_var = id_var,
        arm_var = arm_var,
        visit_var = visit_var,
        cor_struct = cor_struct
      )
    )
  )

  table_list <-
    add_expr(
      list(),
      if (output_table == "t_gee_cov") {
        substitute(
          expr = {
            result_table <- tern.gee::as.rtable(model_fit, type = "cov")
            subtitles(result_table) <- st
            main_footer(result_table) <- mf
          },
          env = list(
            st = basic_table_args$subtitles,
            mf = basic_table_args$main_footer
          )
        )
      } else if (output_table == "t_gee_coef") {
        substitute(
          expr = {
            result_table <- tern.gee::as.rtable(data.frame(Coefficient = model_fit$coefficients))
            subtitles(result_table) <- st
            main_footer(result_table) <- mf
          },
          env = list(
            conf_level = conf_level,
            st = basic_table_args$subtitles,
            mf = basic_table_args$main_footer
          )
        )
      } else if (output_table == "t_gee_lsmeans") {
        substitute(
          expr = {
            lsmeans_fit_model <- tern.gee::lsmeans(model_fit, conf_level)
            result_table <- rtables::basic_table(show_colcounts = TRUE) %>%
              rtables::split_cols_by(var = input_arm_var, ref_group = model_fit$ref_level) %>%
              tern.gee::summarize_gee_logistic() %>%
              rtables::build_table(
                df = lsmeans_fit_model,
                alt_counts_df = dataname_lsmeans
              )

            subtitles(result_table) <- st
            main_footer(result_table) <- mf
            result_table
          },
          env = list(
            dataname_lsmeans = as.name(dataname_lsmeans),
            conf_level = conf_level,
            input_arm_var = input_arm_var,
            st = basic_table_args$subtitles,
            mf = basic_table_args$main_footer
          )
        )
      }
    )
  # Note: l_html_concomitant_adcm is still not included since one column is available out of 9

  y$model <- bracket_expr(model_list)
  y$table <- bracket_expr(table_list)

  y
}

#' teal Module: Generalized Estimating Equations (GEE) analysis
#'
#' This module produces an analysis table using Generalized Estimating Equations (GEE).
#'
#' @inheritParams module_arguments
#' @inheritParams template_arguments
#' @inheritParams template_a_gee
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' library(dplyr)
#' data <- teal_data()
#' data <- within(data, {
#'   ADSL <- tmc_ex_adsl
#'   ADQS <- tmc_ex_adqs %>%
#'     filter(ABLFL != "Y" & ABLFL2 != "Y") %>%
#'     mutate(
#'       AVISIT = as.factor(AVISIT),
#'       AVISITN = rank(AVISITN) %>%
#'         as.factor() %>%
#'         as.numeric() %>%
#'         as.factor(),
#'       AVALBIN = AVAL < 50 # Just as an example to get a binary endpoint.
#'     ) %>%
#'     droplevels()
#' })
#' datanames <- c("ADSL", "ADQS")
#' datanames(data) <- datanames
#' join_keys(data) <- default_cdisc_join_keys[datanames]
#'
#' app <- init(
#'   data = data,
#'   modules = modules(
#'     tm_a_gee(
#'       label = "GEE",
#'       dataname = "ADQS",
#'       aval_var = choices_selected("AVALBIN", fixed = TRUE),
#'       id_var = choices_selected(c("USUBJID", "SUBJID"), "USUBJID"),
#'       arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"),
#'       visit_var = choices_selected(c("AVISIT", "AVISITN"), "AVISIT"),
#'       paramcd = choices_selected(
#'         choices = value_choices(data[["ADQS"]], "PARAMCD", "PARAM"),
#'         selected = "FKSI-FWB"
#'       ),
#'       cov_var = choices_selected(c("BASE", "AGE", "SEX", "BASE:AVISIT"), NULL)
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_a_gee <- function(label,
                     dataname,
                     parentname = ifelse(
                       inherits(arm_var, "data_extract_spec"),
                       teal.transform::datanames_input(arm_var),
                       "ADSL"
                     ),
                     aval_var,
                     id_var,
                     arm_var,
                     visit_var,
                     cov_var,
                     arm_ref_comp = NULL,
                     paramcd,
                     conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE),
                     pre_output = NULL,
                     post_output = NULL,
                     basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_a_gee (prototype)")

  cov_var <- teal.transform::add_no_selected_choices(cov_var, multiple = TRUE)

  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_class(aval_var, "choices_selected")
  checkmate::assert_class(id_var, "choices_selected")
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(visit_var, "choices_selected")
  checkmate::assert_class(cov_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(conf_level, "choices_selected")
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  args <- as.list(environment())

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname),
    id_var = cs_to_des_select(id_var, dataname = dataname),
    visit_var = cs_to_des_select(visit_var, dataname = dataname),
    cov_var = cs_to_des_select(cov_var, dataname = dataname, multiple = TRUE),
    split_covariates = cs_to_des_select(split_choices(cov_var), dataname = dataname, multiple = TRUE),
    aval_var = cs_to_des_select(aval_var, dataname = dataname)
  )

  teal::module(
    label = label,
    server = srv_gee,
    ui = ui_gee,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        arm_ref_comp = arm_ref_comp,
        label = label,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

ui_gee <- function(id, ...) {
  a <- list(...) # module args

  ns <- NS(id)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$arm_var,
    a$paramcd,
    a$id_var,
    a$visit_var,
    a$cov_var,
    a$aval_var
  )

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(
      tags$h3(textOutput(ns("gee_title"))),
      teal.widgets::table_with_settings_ui(ns("table"))
    ),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c("arm_var", "paramcd", "id_var", "visit_var", "cov_var", "aval_var")]),
      teal.transform::data_extract_ui(
        id = ns("aval_var"),
        label = "Analysis Variable",
        data_extract_spec = a$aval_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select Endpoint",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("visit_var"),
        label = "Visit Variable",
        data_extract_spec = a$visit_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("cov_var"),
        label = "Covariates",
        data_extract_spec = a$cov_var,
        is_single_dataset = is_single_dataset_value
      ),
      shinyjs::hidden(
        teal.transform::data_extract_ui(
          id = ns("split_covariates"),
          label = "Split Covariates",
          data_extract_spec = a$split_covariates,
          is_single_dataset = is_single_dataset_value
        )
      ),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      shinyjs::hidden(
        uiOutput(ns("arms_buckets")),
        helpText(
          id = ns("help_text"), "Multiple reference groups are automatically combined into a single group."
        ),
        checkboxInput(
          ns("combine_comp_arms"),
          "Combine all comparison groups?",
          value = FALSE
        )
      ),
      teal.transform::data_extract_ui(
        id = ns("id_var"),
        label = "Subject Identifier",
        data_extract_spec = a$id_var,
        is_single_dataset = is_single_dataset_value
      ),
      selectInput(
        ns("cor_struct"),
        "Correlation Structure",
        choices = c(
          "unstructured",
          "toeplitz", # needs the fix of https://github.com/insightsengineering/tern.gee/issues/3
          "auto-regressive",
          "compound symmetry"
        ),
        selected = "unstructured",
        multiple = FALSE
      ),
      teal.widgets::optionalSelectInput(
        ns("conf_level"),
        "Confidence Level",
        a$conf_level$choices,
        a$conf_level$selected,
        multiple = FALSE,
        fixed = a$conf_level$fixed
      ),
      radioButtons(
        ns("output_table"),
        "Output Type",
        choices = c(
          "LS means" = "t_gee_lsmeans",
          "Covariance" = "t_gee_cov",
          "Coefficients" = "t_gee_coef"
        ),
        selected = "t_gee_lsmeans"
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

srv_gee <- function(id,
                    data,
                    filter_panel_api,
                    reporter,
                    dataname,
                    parentname,
                    arm_var,
                    paramcd,
                    id_var,
                    visit_var,
                    cov_var,
                    split_covariates,
                    aval_var,
                    arm_ref_comp,
                    label,
                    plot_height,
                    plot_width,
                    basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    ## split_covariates ----
    observeEvent(input[[extract_input("cov_var", dataname)]],
      ignoreNULL = FALSE,
      {
        # update covariates as actual variables
        split_interactions_values <- split_interactions(
          input[[extract_input("cov_var", dataname)]]
        )
        arm_var_value <- input[[extract_input("arm_var", parentname)]]
        arm_in_cov <- length(intersect(split_interactions_values, arm_var_value)) >= 1L
        if (arm_in_cov) {
          split_covariates_selected <- setdiff(split_interactions_values, arm_var_value)
        } else {
          split_covariates_selected <- split_interactions_values
        }
        teal.widgets::updateOptionalSelectInput(
          session,
          inputId = extract_input("split_covariates", dataname),
          selected = split_covariates_selected
        )
      }
    )

    ## arm_ref_comp_observer ----
    arm_ref_comp_observer(
      session,
      input,
      output,
      id_arm_var = extract_input("arm_var", parentname),
      data = reactive(data()[[parentname]]),
      arm_ref_comp = arm_ref_comp,
      module = "tm_a_gee"
    )

    ## data_merge_modules ----
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        arm_var = arm_var,
        paramcd = paramcd,
        id_var = id_var,
        visit_var = visit_var,
        split_covariates = split_covariates,
        aval_var = aval_var
      ),
      datasets = data,
      select_validation_rule = list(
        aval_var = shinyvalidate::sv_required("An analysis variable is required"),
        arm_var = shinyvalidate::sv_required("A treatment variable is required"),
        id_var = shinyvalidate::sv_required("A Subject identifier is required"),
        visit_var = shinyvalidate::sv_required("A visit variable is required")
      ),
      filter_validation_rule = list(
        paramcd = shinyvalidate::sv_required("An endpoint is required")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level"))
      iv$add_rule(
        "conf_level",
        shinyvalidate::sv_between(
          0, 1,
          inclusive = c(FALSE, FALSE),
          message_fmt = "Confidence level must be between 0 and 1"
        )
      )
      iv$add_rule("cor_struct", shinyvalidate::sv_required("Please choose a correlation structure"))
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    # Initially hide the output title because there is no output yet.
    shinyjs::show("gee_title")

    validate_checks <- reactive({
      teal::validate_inputs(iv_r())

      # To do in production: add validations.
      NULL
    })

    ## table_r ----
    table_q <- reactive({
      validate_checks()
      output_table <- input$output_table
      conf_level <- as.numeric(input$conf_level)
      col_source <- merged$anl_input_r()$columns_source
      filter_info <- merged$anl_input_r()$filter_info

      req(output_table)

      basic_table_args$subtitles <- paste0(
        "Analysis Variable: ", col_source$aval_var,
        ",  Endpoint: ", filter_info$paramcd[[1]]$selected[[1]],
        ifelse(length(col_source$split_covariates) == 0, "",
          paste(",  Covariates:", paste(col_source$split_covariates, collapse = ", "))
        )
      )
      basic_table_args$main_footer <- c(paste("Correlation Structure:", input$cor_struct))

      my_calls <- template_a_gee(
        output_table = output_table,
        data_model_fit = "ANL",
        dataname_lsmeans = "ANL_ADSL",
        input_arm_var = as.vector(col_source$arm_var),
        conf_level = conf_level,
        aval_var = col_source$aval_var,
        split_covariates = col_source$split_covariates,
        id_var = col_source$id_var,
        arm_var = col_source$arm_var,
        visit_var = col_source$visit_var,
        cor_struct = input$cor_struct,
        basic_table_args = basic_table_args
      )
      teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
    })

    output$gee_title <- renderText({
      # Input on output type.
      output_table <- input$output_table

      output_title <- switch(output_table,
        "t_gee_cov" = "Residual Covariance Matrix Estimate",
        "t_gee_coef" = "Model Coefficients",
        "t_gee_lsmeans" = "LS Means Estimates"
      )
      output_title
    })

    table_r <- reactive({
      table_q()[["result_table"]]
    })

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    # Render R code
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(table_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Generalized Estimating Equations (GEE) Analysis Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        table_type <- switch(input$output_table,
          "t_gee_cov" = "Residual Covariance Matrix Estimate",
          "t_gee_coef" = "Model Coefficients",
          "t_gee_lsmeans" = "LS Means Estimates"
        )
        card$append_text(paste(table_type, "Table"), "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(table_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
  })
}

#' Control Function for Time-To-Event teal Module
#'
#' Controls the arguments for Cox regression and survival analysis results.
#'
#' @param coxph (`list`)\cr control parameters for Cox-PH model. See [tern::control_coxph()] for details.
#' @param surv_time (`list`)\cr control parameters for `survfit` model. See [tern::control_surv_time()] for details.
#' @param surv_timepoint (`list`)\cr control parameters for `survfit` model at time point. See
#'   [tern::control_surv_timepoint()] for details.
#'
#' @seealso [template_tte()], [tm_t_tte()]
#'
#' @keywords internal
control_tte <- function(
    surv_time = list(
      conf_level = 0.95,
      conf_type = "plain",
      quantiles = c(0.25, 0.75)
    ),
    coxph = list(
      pval_method = "log-rank",
      ties = "efron",
      conf_level = 0.95
    ),
    surv_timepoint = control_surv_timepoint(
      conf_level = 0.95,
      conf_type = c("plain", "none", "log", "log-log")
    )) {
  list(
    surv_time = do.call("control_surv_time", surv_time),
    coxph = do.call("control_coxph", coxph),
    surv_timepoint = do.call("control_surv_timepoint", surv_timepoint)
  )
}

#' Template: Time-To-Event
#'
#' Creates a valid expression to generate a time-to-event analysis.
#'
#' @inheritParams template_arguments
#' @param control (`list`)\cr list of settings for the analysis. See [control_tte()] for details.
#' @param event_desc_var (`character`)\cr name of the variable with events description.
#' @param paramcd (`character`)\cr endpoint parameter value to use in the table title.
#'
#' @inherit template_arguments return
#'
#' @seealso [control_tte()], [tm_t_tte()]
#'
#' @keywords internal
template_tte <- function(dataname = "ANL",
                         parentname = "ADSL",
                         arm_var = "ARM",
                         paramcd,
                         ref_arm = NULL,
                         comp_arm = NULL,
                         compare_arm = FALSE,
                         combine_comp_arms = FALSE,
                         aval_var = "AVAL",
                         cnsr_var = "CNSR",
                         strata_var = NULL,
                         time_points = NULL,
                         time_unit_var = "AVALU",
                         event_desc_var = "EVNTDESC",
                         control = control_tte(),
                         add_total = FALSE,
                         total_label = default_total_label(),
                         na_level = default_na_str(),
                         basic_table_args = teal.widgets::basic_table_args()) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(arm_var)
  checkmate::assert_string(aval_var)
  checkmate::assert_string(cnsr_var)
  checkmate::assert_string(time_unit_var)
  checkmate::assert_string(event_desc_var)
  checkmate::assert_flag(compare_arm)
  checkmate::assert_flag(combine_comp_arms)
  checkmate::assert_string(total_label)
  checkmate::assert_string(na_level)

  ref_arm_val <- paste(ref_arm, collapse = "/")
  y <- list()

  data_list <- list()
  data_list <- add_expr(
    data_list,
    prepare_arm(
      dataname = dataname,
      arm_var = arm_var,
      ref_arm = ref_arm,
      comp_arm = comp_arm,
      compare_arm = compare_arm,
      ref_arm_val = ref_arm_val
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = dplyr::mutate(
        is_event = cnsr_var == 0,
        is_not_event = cnsr_var == 1,
        EVNT1 = factor(
          dplyr::case_when(
            is_event == TRUE ~ "Patients with event (%)",
            is_event == FALSE ~ "Patients without event (%)"
          ),
          levels = c("Patients with event (%)", "Patients without event (%)")
        ),
        EVNTDESC = factor(event_desc_var)
      ),
      env = list(
        cnsr_var = as.name(cnsr_var),
        event_desc_var = as.name(event_desc_var)
      )
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = df_explicit_na(na_level = na_str),
      env = list(na_str = na_level)
    )
  )

  y$data <- substitute(
    expr = {
      anl <- data_pipe
      parentname <- arm_preparation %>% df_explicit_na(na_level = na_str)
    },
    env = list(
      data_pipe = pipe_expr(data_list),
      parentname = as.name(parentname),
      arm_preparation = prepare_arm(
        dataname = parentname,
        arm_var = arm_var,
        ref_arm = ref_arm,
        comp_arm = comp_arm,
        compare_arm = compare_arm,
        ref_arm_val = ref_arm_val
      ),
      na_str = na_level
    )
  )

  if (compare_arm && combine_comp_arms) {
    y$combine_comp_arms <- substitute(
      expr = groups <- combine_groups(fct = df[[group]], ref = ref_arm_val),
      env = list(
        df = as.name(parentname),
        group = arm_var,
        ref_arm_val = ref_arm_val
      )
    )
  }
  layout_list <- list()

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(
        show_colcounts = TRUE,
        title = paste("Time-To-Event Table for", paramcd),
        main_footer = if (compare_arm) {
          c(
            paste("p-value method for Coxph (Hazard Ratio):", control$coxph$pval_method),
            paste("Ties for Coxph (Hazard Ratio):", control$coxph$ties),
            paste("Confidence Level Type for Survfit:", control$surv_time$conf_type)
          )
        } else {
          paste("Confidence Level Type for Survfit:", control$surv_time$conf_type)
        }
      )
    )
  )

  layout_list <- add_expr(
    layout_list,
    parsed_basic_table_args
  )

  if (!compare_arm && !combine_comp_arms && add_total) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        rtables::split_cols_by(
          var = arm_var,
          split_fun = add_overall_level(total_label, first = FALSE)
        ),
        env = list(
          arm_var = arm_var,
          total_label = total_label
        )
      )
    )
  } else {
    layout_list <- add_expr(
      layout_list,
      split_col_expr(
        compare = compare_arm,
        combine = combine_comp_arms,
        arm_var = arm_var,
        ref = ref_arm_val
      )
    )
  }

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = analyze_vars(
        "is_event",
        .stats = "count_fraction",
        .labels = c(count_fraction = "Patients with event (%)"),
        na_str = na_str
      ) %>%
        rtables::split_rows_by(
          "EVNT1",
          split_label = "Earliest contributing event",
          split_fun = keep_split_levels("Patients with event (%)"),
          label_pos = "visible",
          child_labels = "hidden",
          indent_mod = 1L,
        ) %>%
        rtables::split_rows_by(event_desc_var, split_fun = drop_split_levels) %>%
        rtables::summarize_row_groups(format = "xx", na_str = na_str) %>%
        analyze_vars(
          "is_not_event",
          .stats = "count_fraction",
          .labels = c(count_fraction = "Patients without event (%)"),
          nested = FALSE,
          show_labels = "hidden",
          na_str = na_str
        ),
      env = list(
        event_desc_var = event_desc_var,
        na_str = na_level
      )
    )
  )

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = surv_time(
        vars = aval_var,
        var_labels = paste0("Time to Event (", as.character(anl$time_unit_var[1]), ")"),
        is_event = "is_event",
        control = list(
          conf_level = conf_level,
          conf_type = conf_type,
          quantiles = quantiles
        ),
        na_str = na_str,
        table_names = "time_to_event"
      ),
      env = c(
        aval_var = aval_var,
        control$surv_time,
        time_unit_var = as.name(time_unit_var),
        na_str = na_level
      )
    )
  )

  if (compare_arm) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = coxph_pairwise(
          vars = aval_var,
          is_event = "is_event",
          var_labels = c("Unstratified Analysis"),
          control = list(
            pval_method = pval_method,
            ties = ties,
            conf_level = conf_level
          ),
          na_str = na_str,
          table_names = "unstratified"
        ),
        env = c(
          aval_var = aval_var,
          control$coxph,
          na_str = na_level
        )
      )
    )
  }

  if (compare_arm && !is.null(strata_var)) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = coxph_pairwise(
          vars = aval_var,
          is_event = "is_event",
          var_labels = paste0("Stratified By: ", paste(strata_var, collapse = ", ")),
          strata = strata_var,
          control = control_coxph(
            pval_method = pval_method,
            ties = ties,
            conf_level = conf_level
          ),
          na_str = na_str,
          table_names = "stratified"
        ),
        env = list(
          aval_var = aval_var,
          strata_var = strata_var,
          pval_method = control$coxph$pval_method,
          ties = control$coxph$ties,
          conf_level = control$coxph$conf_level,
          na_str = na_level
        )
      )
    )
  }

  if (!is.null(time_points)) {
    method <- ifelse(compare_arm, "both", "surv")
    indents <- if (compare_arm) {
      c(
        "pt_at_risk" = 0L, "event_free_rate" = 0L, "rate_ci" = 0L,
        "rate_diff" = 1L, "rate_diff_ci" = 1L, "ztest_pval" = 1L
      )
    } else {
      NULL
    }
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = surv_timepoint(
          vars = aval_var,
          var_labels = as.character(anl$time_unit_var[1]),
          is_event = "is_event",
          time_point = time_points,
          method = method,
          control = control_surv_timepoint(
            conf_level = conf_level,
            conf_type = conf_type
          ),
          .indent_mods = indents,
          na_str = na_str
        ),
        env = list(
          aval_var = aval_var,
          time_points = time_points,
          method = method,
          indents = indents,
          time_unit_var = as.name(time_unit_var),
          conf_level = control$surv_timepoint$conf_level,
          conf_type = control$surv_timepoint$conf_type,
          na_str = na_level
        )
      )
    )
  }

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  y$table <- substitute(
    expr = {
      table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parentname)
      table
    },
    env = list(parentname = as.name(parentname))
  )

  y
}

#' teal Module: Time-To-Event Table
#'
#' This module produces a time-to-event analysis summary table, consistent with the TLG Catalog
#' template for `TTET01` available [here](
#' https://insightsengineering.github.io/tlg-catalog/stable/tables/efficacy/ttet01.html).
#'
#' @inheritParams module_arguments
#' @inheritParams template_tte
#' @param conf_level_coxph ([teal.transform::choices_selected()])\cr object with all available choices and
#'   pre-selected option for confidence level, each within range of (0, 1).
#' @param conf_level_survfit ([teal.transform::choices_selected()])\cr object with all available choices and
#'   pre-selected option for confidence level, each within range of (0, 1).
#' @param event_desc_var (`character` or [data_extract_spec()])\cr variable name with the event description
#'   information, optional.
#'
#' @details
#' * The core functionality of this module is based on [coxph_pairwise()], [surv_timepoint()], and [surv_time()] from
#' the `tern` package.
#' * The arm and stratification variables are taken from the `parentname` data.
#' * The following variables are used in the module:
#'
#'   * `AVAL`: time to event
#'   * `CNSR`: 1 if record in `AVAL` is censored, 0 otherwise
#'   * `PARAMCD`: variable used to filter for endpoint (e.g. OS). After
#'     filtering for `PARAMCD` one observation per patient is expected
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' ADSL <- tmc_ex_adsl
#' ADTTE <- tmc_ex_adtte
#'
#' arm_ref_comp <- list(
#'   ACTARMCD = list(
#'     ref = "ARM B",
#'     comp = c("ARM A", "ARM C")
#'   ),
#'   ARM = list(
#'     ref = "B: Placebo",
#'     comp = c("A: Drug X", "C: Combination")
#'   )
#' )
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADTTE = ADTTE,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADTTE <- tmc_ex_adtte
#'     "
#'   ),
#'   modules = modules(
#'     tm_t_tte(
#'       label = "Time To Event Table",
#'       dataname = "ADTTE",
#'       arm_var = choices_selected(
#'         variable_choices(ADSL, c("ARM", "ARMCD", "ACTARMCD")),
#'         "ARM"
#'       ),
#'       arm_ref_comp = arm_ref_comp,
#'       paramcd = choices_selected(
#'         value_choices(ADTTE, "PARAMCD", "PARAM"),
#'         "OS"
#'       ),
#'       strata_var = choices_selected(
#'         variable_choices(ADSL, c("SEX", "BMRKR2")),
#'         "SEX"
#'       ),
#'       time_points = choices_selected(c(182, 243), 182),
#'       event_desc_var = choices_selected(
#'         variable_choices(ADTTE, "EVNTDESC"),
#'         "EVNTDESC",
#'         fixed = TRUE
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_tte <- function(label,
                     dataname,
                     parentname = ifelse(
                       inherits(arm_var, "data_extract_spec"),
                       teal.transform::datanames_input(arm_var),
                       "ADSL"
                     ),
                     arm_var,
                     arm_ref_comp = NULL,
                     paramcd,
                     strata_var,
                     aval_var = teal.transform::choices_selected(
                       teal.transform::variable_choices(dataname, "AVAL"), "AVAL",
                       fixed = TRUE
                     ),
                     cnsr_var = teal.transform::choices_selected(
                       teal.transform::variable_choices(dataname, "CNSR"), "CNSR",
                       fixed = TRUE
                     ),
                     conf_level_coxph = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE),
                     conf_level_survfit = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE),
                     time_points,
                     time_unit_var = teal.transform::choices_selected(
                       teal.transform::variable_choices(dataname, "AVALU"), "AVALU",
                       fixed = TRUE
                     ),
                     event_desc_var = teal.transform::choices_selected("EVNTDESC", "EVNTDESC", fixed = TRUE),
                     add_total = FALSE,
                     total_label = default_total_label(),
                     na_level = default_na_str(),
                     pre_output = NULL,
                     post_output = NULL,
                     basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_tte")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(strata_var, "choices_selected")
  checkmate::assert_class(aval_var, "choices_selected")
  checkmate::assert_class(cnsr_var, "choices_selected")
  checkmate::assert_class(conf_level_coxph, "choices_selected")
  checkmate::assert_class(conf_level_survfit, "choices_selected")
  checkmate::assert_class(time_points, "choices_selected")
  checkmate::assert_class(time_unit_var, "choices_selected")
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_string(na_level)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  args <- as.list(environment())

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname),
    aval_var = cs_to_des_select(aval_var, dataname = dataname),
    cnsr_var = cs_to_des_select(cnsr_var, dataname = dataname),
    strata_var = cs_to_des_select(strata_var, dataname = parentname, multiple = TRUE),
    event_desc_var = cs_to_des_select(event_desc_var, dataname = dataname),
    time_unit_var = cs_to_des_select(time_unit_var, dataname = dataname)
  )

  module(
    label = label,
    server = srv_t_tte,
    ui = ui_t_tte,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        arm_ref_comp = arm_ref_comp,
        label = label,
        total_label = total_label,
        na_level = na_level,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_t_tte <- function(id, ...) {
  a <- list(...) # module args
  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$arm_var,
    a$paramcd,
    a$aval_var,
    a$cnsr_var,
    a$strata_var,
    a$event_desc_var,
    a$time_unit_var
  )

  ns <- NS(id)

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(
        a[c("arm_var", "paramcd", "aval_var", "cnsr_var", "strata_var", "event_desc_var")]
      ),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select Endpoint",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("aval_var"),
        label = "Analysis Variable",
        data_extract_spec = a$aval_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("cnsr_var"),
        label = "Censor Variable",
        data_extract_spec = a$cnsr_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      tags$div(
        class = "arm-comp-box",
        tags$label("Compare Treatments"),
        shinyWidgets::switchInput(
          inputId = ns("compare_arms"),
          value = !is.null(a$arm_ref_comp),
          size = "mini"
        ),
        conditionalPanel(
          condition = paste0("input['", ns("compare_arms"), "']"),
          tags$div(
            uiOutput(ns("arms_buckets")),
            uiOutput(ns("helptext_ui")),
            checkboxInput(
              ns("combine_comp_arms"),
              "Combine all comparison groups?",
              value = FALSE
            ),
            teal.transform::data_extract_ui(
              id = ns("strata_var"),
              label = "Stratify by",
              data_extract_spec = a$strata_var,
              is_single_dataset = is_single_dataset_value
            )
          )
        )
      ),
      conditionalPanel(
        condition = paste0("!input['", ns("compare_arms"), "']"),
        checkboxInput(ns("add_total"), "Add All Patients column", value = a$add_total)
      ),
      teal.widgets::optionalSelectInput(ns("time_points"),
        "Time Points",
        a$time_points$choices,
        a$time_points$selected,
        multiple = TRUE,
        fixed = a$time_points$fixed
      ),
      teal.transform::data_extract_ui(
        id = ns("event_desc_var"),
        label = "Event Description Variable",
        data_extract_spec = a$event_desc_var,
        is_single_dataset = is_single_dataset_value
      ),
      conditionalPanel(
        condition = paste0("input['", ns("compare_arms"), "']"),
        teal.widgets::panel_item(
          "Comparison settings",
          radioButtons(
            ns("pval_method_coxph"),
            label = HTML(
              paste(
                "p-value method for ",
                tags$span(class = "text-primary", "Coxph"),
                " (Hazard Ratio)",
                sep = ""
              )
            ),
            choices = c("wald", "log-rank", "likelihood"),
            selected = "log-rank"
          ),
          radioButtons(
            ns("ties_coxph"),
            label = HTML(
              paste(
                "Ties for ",
                tags$span(class = "text-primary", "Coxph"),
                " (Hazard Ratio)",
                sep = ""
              )
            ),
            choices = c("exact", "breslow", "efron"),
            selected = "exact"
          ),
          teal.widgets::optionalSelectInput(
            inputId = ns("conf_level_coxph"),
            label = HTML(
              paste(
                "Confidence Level for ",
                tags$span(class = "text-primary", "Coxph"),
                " (Hazard Ratio)",
                sep = ""
              )
            ),
            a$conf_level_coxph$choices,
            a$conf_level_coxph$selected,
            multiple = FALSE,
            fixed = a$conf_level_coxph$fixed
          )
        )
      ),
      teal.widgets::panel_item(
        "Additional table settings",
        teal.widgets::optionalSelectInput(
          inputId = ns("conf_level_survfit"),
          label = HTML(
            paste(
              "Confidence Level for ",
              tags$span(class = "text-primary", "Survfit"),
              " (KM Median Estimate & Event Free Rate)",
              sep = ""
            )
          ),
          a$conf_level_survfit$choices,
          a$conf_level_survfit$selected,
          multiple = FALSE,
          fixed = a$conf_level_survfit$fixed
        ),
        radioButtons(
          ns("conf_type_survfit"),
          "Confidence Level Type for Survfit",
          choices = c("plain", "log", "log-log"),
          selected = "plain"
        ),
        sliderInput(
          inputId = ns("probs_survfit"),
          label = "KM Estimate Percentiles",
          min = 0.01,
          max = 0.99,
          value = c(0.25, 0.75),
          width = "100%"
        ),
        teal.transform::data_extract_ui(
          id = ns("time_unit_var"),
          label = "Time Unit Variable",
          data_extract_spec = a$time_unit_var,
          is_single_dataset = is_single_dataset_value
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_t_tte <- function(id,
                      data,
                      filter_panel_api,
                      reporter,
                      arm_var,
                      paramcd,
                      aval_var,
                      cnsr_var,
                      strata_var,
                      event_desc_var,
                      dataname,
                      parentname,
                      arm_ref_comp,
                      time_unit_var,
                      add_total,
                      total_label,
                      label,
                      na_level,
                      basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")
  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    # Setup arm variable selection, default reference arms, and default
    # comparison arms for encoding panel
    iv_arm_ref <- arm_ref_comp_observer(
      session,
      input,
      output,
      id_arm_var = extract_input("arm_var", parentname),
      data = reactive(data()[[parentname]]),
      arm_ref_comp = arm_ref_comp,
      module = "tm_t_tte",
      on_off = reactive(input$compare_arms)
    )

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        arm_var = arm_var,
        paramcd = paramcd,
        aval_var = aval_var,
        cnsr_var = cnsr_var,
        strata_var = strata_var,
        event_desc_var = event_desc_var,
        time_unit_var = time_unit_var
      ),
      datasets = data,
      select_validation_rule = list(
        aval_var = shinyvalidate::sv_required("An analysis variable is required"),
        cnsr_var = shinyvalidate::sv_required("A censor variable is required"),
        arm_var = shinyvalidate::sv_required("A treatment variable is required"),
        event_desc_var = shinyvalidate::sv_required("An event description variable is required"),
        time_unit_var = shinyvalidate::sv_required("A Time unit variable is required")
      ),
      filter_validation_rule = list(
        paramcd = shinyvalidate::sv_required("An endpoint is required")
      )
    )

    output$helptext_ui <- renderUI({
      req(selector_list()$arm_var()$select)
      helpText("Multiple reference groups are automatically combined into a single group.")
    })

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()

      if (isTRUE(input$compare_arms)) {
        iv$add_validator(iv_arm_ref)
      }

      iv$add_rule("conf_level_coxph", shinyvalidate::sv_required("Please choose a hazard ratio confidence level"))
      iv$add_rule(
        "conf_level_coxph", shinyvalidate::sv_between(
          0, 1,
          message_fmt = "Hazard ratio confidence level must between 0 and 1"
        )
      )
      iv$add_rule("conf_level_survfit", shinyvalidate::sv_required("Please choose a KM confidence level"))
      iv$add_rule(
        "conf_level_survfit", shinyvalidate::sv_between(
          0, 1,
          message_fmt = "KM confidence level must between 0 and 1"
        )
      )
      iv$add_rule(
        "probs_survfit",
        ~ if (!is.null(.) && .[1] == .[2]) "KM Estimate Percentiles cannot have a range of size 0"
      )
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_merge_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_merge_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      join_keys = teal.data::join_keys(data),
      data_extract = list(arm_var = arm_var, strata_var = strata_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_merge_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_merge_inputs()$expr))
    })

    # Prepare the analysis environment (filter data, check data, populate envir).
    validate_checks <- reactive({
      teal::validate_inputs(iv_r())
      adsl_filtered <- anl_q()[[parentname]]
      anl_filtered <- anl_q()[[dataname]]
      anl <- anl_q()[["ANL"]]

      anl_m <- anl_merge_inputs()
      input_arm_var <- as.vector(anl_m$columns_source$arm_var)
      input_strata_var <- as.vector(anl_m$columns_source$strata_var)
      input_aval_var <- as.vector(anl_m$columns_source$aval_var)
      input_cnsr_var <- as.vector(anl_m$columns_source$cnsr_var)
      input_event_desc <- as.vector(anl_m$columns_source$event_desc_var)
      input_time_unit_var <- as.vector(anl_m$columns_source$time_unit_var)
      input_paramcd <- unlist(paramcd$filter)["vars_selected"]

      # validate inputs
      validate_args <- list(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var, input_strata_var),
        anl = anl_filtered,
        anlvars = c(
          "USUBJID", "STUDYID", input_paramcd, input_aval_var,
          input_cnsr_var, input_event_desc, input_time_unit_var
        ),
        arm_var = input_arm_var
      )

      # validate arm levels
      if (length(input_arm_var) > 0 && length(unique(adsl_filtered[[input_arm_var]])) == 1) {
        validate_args <- append(validate_args, list(min_n_levels_armvar = NULL))
      }
      if (isTRUE(input$compare_arms)) {
        validate_args <- append(
          validate_args,
          list(ref_arm = unlist(input$buckets$Ref), comp_arm = unlist(input$buckets$Comp))
        )
      }

      do.call(what = "validate_standard_inputs", validate_args)

      # check that there is at least one record with no missing data
      validate(shiny::need(
        !all(is.na(anl[[input_aval_var]])),
        "ANCOVA table cannot be calculated as all values are missing."
      ))

      NULL
    })

    # The R-code corresponding to the analysis.

    all_q <- reactive({
      validate_checks()

      anl_m <- anl_merge_inputs()

      strata_var <- as.vector(anl_m$columns_source$strata_var)

      my_calls <- template_tte(
        dataname = "ANL",
        parentname = "ANL_ADSL",
        arm_var = as.vector(anl_m$columns_source$arm_var),
        paramcd = unlist(anl_m$filter_info$paramcd)["selected"],
        ref_arm = unlist(input$buckets$Ref),
        comp_arm = unlist(input$buckets$Comp),
        compare_arm = input$compare_arms,
        combine_comp_arms = input$combine_comp_arms && input$compare_arms,
        aval_var = as.vector(anl_m$columns_source$aval_var),
        cnsr_var = as.vector(anl_m$columns_source$cnsr_var),
        strata_var = if (length(strata_var) != 0) strata_var else NULL,
        time_points = as.numeric(input$time_points),
        time_unit_var = as.vector(anl_m$columns_source$time_unit_var),
        event_desc_var = as.vector(anl_m$columns_source$event_desc_var),
        control = control_tte(
          coxph = control_coxph(
            pval_method = input$pval_method_coxph,
            ties = input$ties_coxph,
            conf_level = as.numeric(input$conf_level_coxph)
          ),
          surv_time = control_surv_time(
            conf_level = as.numeric(input$conf_level_survfit),
            conf_type = input$conf_type_survfit,
            quantiles = input$probs_survfit
          ),
          surv_timepoint = control_surv_timepoint(
            conf_level = as.numeric(input$conf_level_survfit),
            conf_type = input$conf_type_survfit
          )
        ),
        add_total = input$add_total,
        total_label = total_label,
        na_level = na_level,
        basic_table_args = basic_table_args
      )

      anl_q() %>% teal.code::eval_code(as.expression(my_calls))
    })

    table_r <- reactive(all_q()[["table"]])

    teal.widgets::table_with_settings_srv(id = "table", table_r = table_r)

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Time To Event Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Abnormality Summary Table
#'
#' Creates a valid expression to generate a table to summarize abnormality.
#'
#' @inheritParams template_arguments
#' @param exclude_base_abn (`logical`)\cr whether to exclude patients who had abnormal values at baseline.
#' @param grade (`character`)\cr name of the variable used to
#'   specify the abnormality grade. Variable must be factor.
#' @param abnormal (`named list`)\cr indicating abnormality direction and grades.
#' @param baseline_var (`character`)\cr
#'   name of the variable specifying baseline abnormality grade.
#' @param na_level (`character`)\cr the NA level in the input dataset, defaults to `"<Missing>"`.
#' @param tbl_title (`character`)\cr Title with label of variables from by bars
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_abnormality()]
#' @keywords internal
#'
template_abnormality <- function(parentname,
                                 dataname,
                                 arm_var,
                                 id_var = "USUBJID",
                                 by_vars,
                                 abnormal = list(low = c("LOW", "LOW LOW"), high = c("HIGH", "HIGH HIGH")),
                                 grade = "ANRIND",
                                 baseline_var = "BNRIND",
                                 treatment_flag_var = "ONTRTFL",
                                 treatment_flag = "Y",
                                 add_total = FALSE,
                                 total_label = default_total_label(),
                                 exclude_base_abn = FALSE,
                                 drop_arm_levels = TRUE,
                                 na_level = default_na_str(),
                                 basic_table_args = teal.widgets::basic_table_args(),
                                 tbl_title) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(id_var)
  checkmate::assert_string(parentname)
  checkmate::assert_string(arm_var)
  checkmate::check_character(by_vars)
  checkmate::check_list(abnormal)
  checkmate::assert_string(grade)
  checkmate::assert_string(baseline_var)
  checkmate::assert_string(treatment_flag_var)
  checkmate::assert_string(treatment_flag)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_flag(exclude_base_abn)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_string(tbl_title)

  y <- list()

  data_list <- list()

  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl <- df %>%
        dplyr::filter(treatment_flag_var == treatment_flag & !is.na(grade) & grade != na_level),
      env = list(
        df = as.name(dataname),
        grade = as.name(grade),
        treatment_flag_var = as.name(treatment_flag_var),
        treatment_flag = treatment_flag,
        na_level = na_level
      )
    )
  )

  data_list <- add_expr(
    data_list,
    prepare_arm_levels(
      dataname = "anl",
      parentname = parentname,
      arm_var = arm_var,
      drop_arm_levels = drop_arm_levels
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      dataname <- df_explicit_na(dataname, na_level = na_level),
      env = list(dataname = as.name("anl"), na_level = na_level)
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      parentname <- df_explicit_na(parentname, na_level = na_level),
      env = list(parentname = as.name(parentname), na_level = na_level)
    )
  )

  y$data <- bracket_expr(data_list)

  # layout start
  prep_list <- list()
  prep_list <- add_expr(
    prep_list,
    substitute(
      # Define the map for layout using helper function h_map_for_count_abnormal
      map <- h_map_for_count_abnormal(
        df = dataname,
        variables = list(anl = grade, split_rows = by_vars),
        abnormal = abnormal,
        method = "default",
        na_str = na_level
      ),
      env = list(dataname = as.name("anl"), by_vars = by_vars, grade = grade, abnormal = abnormal, na_level = na_level)
    )
  )

  y$layout_prep <- bracket_expr(prep_list)

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(
        show_colcounts = TRUE,
        title = tbl_title,
        main_footer = "Variables without observed abnormalities are excluded."
      )
    )
  )

  layout_list <- list()


  layout_list <- add_expr(
    layout_list,
    if (add_total) {
      substitute(
        expr = expr_basic_table_args %>%
          rtables::split_cols_by(
            var = arm_var,
            split_fun = add_overall_level(total_label, first = FALSE)
          ),
        env = list(
          arm_var = arm_var,
          total_label = total_label,
          expr_basic_table_args = parsed_basic_table_args
        )
      )
    } else {
      substitute(
        expr = expr_basic_table_args %>%
          rtables::split_cols_by(var = arm_var),
        env = list(arm_var = arm_var, expr_basic_table_args = parsed_basic_table_args)
      )
    }
  )

  for (by_var in by_vars) {
    split_label <- substitute(
      expr = teal.data::col_labels(dataname, fill = FALSE)[[by_var]],
      env = list(
        dataname = as.name(dataname),
        by_var = by_var
      )
    )
    layout_list <- add_expr(
      layout_list,
      substitute(
        rtables::split_rows_by(
          by_var,
          split_label = split_label,
          label_pos = "topleft",
          split_fun = trim_levels_to_map(map = map)
        ),
        env = list(
          by_var = by_var,
          split_label = split_label,
          map = as.name("map")
        )
      )
    )
  }

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = count_abnormal(
        var = grade,
        abnormal = abnormal,
        variables = list(id = id_var, baseline = baseline_var),
        .indent_mods = 4L,
        exclude_base_abn = exclude_base_abn
      ) %>%
        append_varlabels(dataname, grade, indent = indent_space),
      env = list(
        grade = grade,
        abnormal = abnormal,
        id_var = id_var,
        baseline_var = baseline_var,
        exclude_base_abn = exclude_base_abn,
        dataname = as.name(dataname),
        by_vars = by_vars,
        indent_space = length(by_vars)
      )
    )
  )

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  y$table <- substitute(
    expr = {
      result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) %>%
        rtables::prune_table()
      result
    },
    env = list(parent = as.name(parentname))
  )

  y
}

#' teal Module: Abnormality Summary Table
#'
#' This module produces a table to summarize abnormality.
#'
#' @inheritParams module_arguments
#' @inheritParams template_abnormality
#' @param grade ([teal.transform::choices_selected()])\cr
#'   object with all available choices and preselected option for variable names that can be used to
#'   specify the abnormality grade. Variable must be factor.
#' @param abnormal (`named list`)\cr defined by user to indicate what abnormalities are to be displayed.
#' @param baseline_var ([teal.transform::choices_selected()])\cr
#'   variable for baseline abnormality grade.
#' @param na_level (`character`)\cr the NA level in the input dataset, default to `"<Missing>"`.
#'
#' @inherit module_arguments return seealso
#'
#' @note Patients with the same abnormality at baseline as on the treatment visit can be
#'   excluded in accordance with GDSR specifications by using `exclude_base_abn`.
#'
#' @examples
#'
#' data <- teal_data()
#' data <- within(data, {
#'   library(dplyr)
#'
#'   ADSL <- tmc_ex_adsl
#'   ADLB <- tmc_ex_adlb %>%
#'     mutate(
#'       ONTRTFL = case_when(
#'         AVISIT %in% c("SCREENING", "BASELINE") ~ "",
#'         TRUE ~ "Y"
#'       ) %>% with_label("On Treatment Record Flag")
#'     )
#' })
#' datanames <- c("ADSL", "ADLB")
#' datanames(data) <- datanames
#' join_keys(data) <- default_cdisc_join_keys[datanames]
#'
#' app <- init(
#'   data = data,
#'   modules = modules(
#'     tm_t_abnormality(
#'       label = "Abnormality Table",
#'       dataname = "ADLB",
#'       arm_var = choices_selected(
#'         choices = variable_choices(data[["ADSL"]], subset = c("ARM", "ARMCD")),
#'         selected = "ARM"
#'       ),
#'       add_total = FALSE,
#'       by_vars = choices_selected(
#'         choices = variable_choices(data[["ADLB"]], subset = c("LBCAT", "PARAM", "AVISIT")),
#'         selected = c("LBCAT", "PARAM"),
#'         keep_order = TRUE
#'       ),
#'       baseline_var = choices_selected(
#'         variable_choices(data[["ADLB"]], subset = "BNRIND"),
#'         selected = "BNRIND", fixed = TRUE
#'       ),
#'       grade = choices_selected(
#'         choices = variable_choices(data[["ADLB"]], subset = "ANRIND"),
#'         selected = "ANRIND",
#'         fixed = TRUE
#'       ),
#'       abnormal = list(low = "LOW", high = "HIGH"),
#'       exclude_base_abn = FALSE
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_abnormality <- function(label,
                             dataname,
                             parentname = ifelse(
                               inherits(arm_var, "data_extract_spec"),
                               teal.transform::datanames_input(arm_var),
                               "ADSL"
                             ),
                             arm_var,
                             by_vars,
                             grade,
                             abnormal = list(low = c("LOW", "LOW LOW"), high = c("HIGH", "HIGH HIGH")),
                             id_var = teal.transform::choices_selected(
                               teal.transform::variable_choices(dataname, subset = "USUBJID"),
                               selected = "USUBJID", fixed = TRUE
                             ),
                             baseline_var = teal.transform::choices_selected(
                               teal.transform::variable_choices(dataname, subset = "BNRIND"),
                               selected = "BNRIND", fixed = TRUE
                             ),
                             treatment_flag_var = teal.transform::choices_selected(
                               teal.transform::variable_choices(dataname, subset = "ONTRTFL"),
                               selected = "ONTRTFL", fixed = TRUE
                             ),
                             treatment_flag = teal.transform::choices_selected("Y"),
                             add_total = TRUE,
                             total_label = default_total_label(),
                             exclude_base_abn = FALSE,
                             drop_arm_levels = TRUE,
                             pre_output = NULL,
                             post_output = NULL,
                             na_level = default_na_str(),
                             basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_abnormality")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(na_level)
  checkmate::assert_list(abnormal, types = "character", len = 2)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(by_vars, "choices_selected")
  checkmate::assert_class(grade, "choices_selected")
  checkmate::assert_class(id_var, "choices_selected")
  checkmate::assert_class(baseline_var, "choices_selected")
  checkmate::assert_class(treatment_flag_var, "choices_selected")
  checkmate::assert_class(treatment_flag, "choices_selected")
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_flag(exclude_base_abn)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    id_var = cs_to_des_select(id_var, dataname = dataname),
    by_vars = cs_to_des_select(by_vars, dataname = dataname, multiple = TRUE, ordered = TRUE),
    grade = cs_to_des_select(grade, dataname = dataname),
    baseline_var = cs_to_des_select(baseline_var, dataname = dataname),
    treatment_flag_var = cs_to_des_select(treatment_flag_var, dataname = dataname)
  )

  args <- as.list(environment())

  module(
    label = label,
    ui = ui_t_abnormality,
    server = srv_t_abnormality,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        abnormal = abnormal,
        treatment_flag = treatment_flag,
        label = label,
        total_label = total_label,
        na_level = na_level,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_t_abnormality <- function(id, ...) {
  ns <- NS(id)
  a <- list(...) # module args

  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$arm_var,
    a$id_var,
    a$by_vars,
    a$grade,
    a$baseline_var,
    a$treatment_flag_var,
    a$treatment_flag
  )

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(
        a[c("arm_var", "id_var", "by_vars", "grade", "baseline_var", "treatment_flag_var")]
      ),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      checkboxInput(ns("add_total"), "Add All Patients column", value = a$add_total),
      teal.transform::data_extract_ui(
        id = ns("by_vars"),
        label = "Row By Variable",
        data_extract_spec = a$by_vars,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("grade"),
        label = "Grade Variable",
        data_extract_spec = a$grade,
        is_single_dataset = is_single_dataset_value
      ),
      checkboxInput(
        ns("exclude_base_abn"),
        "Exclude subjects whose baseline grade is the same as abnormal grade",
        value = a$exclude_base_abn
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional table settings",
          checkboxInput(
            ns("drop_arm_levels"),
            label = "Drop columns not in filtered analysis dataset",
            value = a$drop_arm_levels
          )
        )
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional Variables Info",
          teal.transform::data_extract_ui(
            id = ns("id_var"),
            label = "Subject Identifier",
            data_extract_spec = a$id_var,
            is_single_dataset = is_single_dataset_value
          ),
          teal.transform::data_extract_ui(
            id = ns("baseline_var"),
            label = "Baseline Grade Variable",
            data_extract_spec = a$baseline_var,
            is_single_dataset = is_single_dataset_value
          ),
          teal.transform::data_extract_ui(
            id = ns("treatment_flag_var"),
            label = "On Treatment Flag Variable",
            data_extract_spec = a$treatment_flag_var,
            is_single_dataset = is_single_dataset_value
          ),
          teal.widgets::optionalSelectInput(
            ns("treatment_flag"),
            label = "Value Indicating On Treatment",
            multiple = FALSE,
            fixed_on_single = TRUE
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_t_abnormality <- function(id,
                              data,
                              reporter,
                              filter_panel_api,
                              dataname,
                              parentname,
                              abnormal,
                              arm_var,
                              id_var,
                              by_vars,
                              grade,
                              baseline_var,
                              treatment_flag_var,
                              treatment_flag,
                              add_total,
                              total_label,
                              drop_arm_levels,
                              label,
                              na_level,
                              basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        arm_var = arm_var,
        id_var = id_var,
        by_vars = by_vars,
        grade = grade,
        baseline_var = baseline_var,
        treatment_flag_var = treatment_flag_var
      ),
      datasets = data,
      select_validation_rule = list(
        arm_var = shinyvalidate::sv_required(
          "Please select a treatment variable."
        ),
        by_vars = shinyvalidate::sv_required(
          "Please select a Row By Variable."
        ),
        id_var = shinyvalidate::sv_required(
          "Please select a subject identifier."
        ),
        grade = shinyvalidate::sv_required(
          "Please select a grade variable."
        ),
        baseline_var = shinyvalidate::sv_required(
          "Please select a baseline grade variable."
        ),
        treatment_flag_var = shinyvalidate::sv_required(
          "Please select indicator value for on treatment records."
        )
      )
    )

    isolate({
      resolved <- teal.transform::resolve_delayed(treatment_flag, as.list(data()@env))
      teal.widgets::updateOptionalSelectInput(
        session = session,
        inputId = "treatment_flag",
        choices = resolved$choices,
        selected = resolved$selected
      )
    })

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("treatment_flag", shinyvalidate::sv_required(
        "Please select indicator value for on treatment records."
      ))
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    validate_checks <- reactive({
      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]

      teal::validate_inputs(iv_r())

      input_arm_var <- names(merged$anl_input_r()$columns_source$arm_var)
      input_id_var <- names(merged$anl_input_r()$columns_source$id_var)
      input_by_vars <- names(merged$anl_input_r()$columns_source$by_vars)
      input_grade <- names(merged$anl_input_r()$columns_source$grade)
      input_baseline_var <- names(merged$anl_input_r()$columns_source$baseline_var)
      input_treatment_flag_var <- names(merged$anl_input_r()$columns_source$treatment_flag_var)

      # validate inputs
      validate_standard_inputs(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_id_var, input_by_vars, input_grade),
        arm_var = input_arm_var
      )
    })

    all_q <- reactive({
      validate_checks()

      by_vars_names <- merged$anl_input_r()$columns_source$by_vars
      by_vars_labels <- as.character(sapply(by_vars_names, function(name) {
        attr(merged$anl_q()[["ANL"]][[name]], "label")
      }))

      tbl_title <- ifelse(
        length(by_vars_labels) == 1,
        paste("Laboratory Abnormality summary by", by_vars_labels),
        paste(paste("Laboratory Abnormality summary by", paste(by_vars_labels, collapse = ", ")))
      )

      my_calls <- template_abnormality(
        parentname = "ANL_ADSL",
        dataname = "ANL",
        arm_var = as.vector(merged$anl_input_r()$columns_source$arm_var),
        by_vars = merged$anl_input_r()$columns_source$by_vars,
        id_var = as.vector(merged$anl_input_r()$columns_source$id_var),
        abnormal = abnormal,
        grade = as.vector(merged$anl_input_r()$columns_source$grade),
        baseline_var = as.vector(merged$anl_input_r()$columns_source$baseline_var),
        treatment_flag_var = as.vector(merged$anl_input_r()$columns_source$treatment_flag_var),
        treatment_flag = input$treatment_flag,
        add_total = input$add_total,
        total_label = total_label,
        exclude_base_abn = input$exclude_base_abn,
        drop_arm_levels = input$drop_arm_levels,
        na_level = na_level,
        basic_table_args = basic_table_args,
        tbl_title = tbl_title
      )

      teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
    })

    # Outputs to render.
    table_r <- reactive(all_q()[["result"]])

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    # Render R code.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Abnormality Summary Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Survival Forest Plot
#'
#' Creates a valid expression to generate a survival forest plot.
#'
#' @inheritParams template_arguments
#' @inheritParams template_forest_rsp
#' @param stats (`character`)\cr the names of statistics to be reported among:
#'   * `n_tot_events`: Total number of events per group.
#'   * `n_events`: Number of events per group.
#'   * `n_tot`: Total number of observations per group.
#'   * `n`: Number of observations per group.
#'   * `median`: Median survival time.
#'   * `hr`: Hazard ratio.
#'   * `ci`: Confidence interval of hazard ratio.
#'   * `pval`: p-value of the effect.
#'   Note, one of the statistics `n_tot` and `n_tot_events`, as well as both `hr` and `ci`
#'   are required.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_g_forest_tte()]
#'
#' @keywords internal
template_forest_tte <- function(dataname = "ANL",
                                parentname = "ANL_ADSL",
                                arm_var,
                                ref_arm = NULL,
                                comp_arm = NULL,
                                obj_var_name = "",
                                aval_var = "AVAL",
                                cnsr_var = "CNSR",
                                subgroup_var,
                                strata_var = NULL,
                                stats = c("n_tot_events", "n_events", "median", "hr", "ci"),
                                riskdiff = NULL,
                                conf_level = 0.95,
                                col_symbol_size = NULL,
                                time_unit_var = "AVALU",
                                rel_width_forest = 0.25,
                                font_size = 15,
                                ggplot2_args = teal.widgets::ggplot2_args()) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(arm_var)
  checkmate::assert_string(obj_var_name)
  checkmate::assert_character(subgroup_var, null.ok = TRUE)
  checkmate::assert_character(stats, min.len = 3)
  checkmate::assert_true(any(c("n_tot", "n_tot_events") %in% stats))
  checkmate::assert_true(all(c("hr", "ci") %in% stats))
  checkmate::assert_list(riskdiff, null.ok = TRUE)
  checkmate::assert_number(rel_width_forest, lower = 0, upper = 1)
  checkmate::assert_number(font_size)

  y <- list()
  ref_arm_val <- paste(ref_arm, collapse = "/")

  # Data processing.
  data_list <- list()
  anl_list <- list()
  parent_list <- list()

  anl_list <- add_expr(
    anl_list,
    prepare_arm(
      dataname = dataname,
      arm_var = arm_var,
      ref_arm = ref_arm,
      comp_arm = comp_arm,
      ref_arm_val = ref_arm_val
    )
  )

  anl_list <- add_expr(
    anl_list,
    substitute_names(
      expr = {
        dplyr::mutate(arm_var = combine_levels(arm_var, comp_arm)) %>%
          dplyr::mutate(is_event = cnsr_var == 0)
      },
      names = list(arm_var = as.name(arm_var)),
      others = list(
        comp_arm = comp_arm,
        cnsr_var = as.name(cnsr_var)
      )
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      anl <- anl_list,
      env = list(
        anl_list = pipe_expr(anl_list)
      )
    )
  )

  parent_list <- add_expr(
    parent_list,
    prepare_arm(
      dataname = parentname,
      arm_var = arm_var,
      ref_arm = ref_arm,
      comp_arm = comp_arm,
      ref_arm_val = ref_arm_val
    )
  )

  parent_list <- add_expr(
    parent_list,
    substitute_names(
      expr = dplyr::mutate(arm_var = combine_levels(arm_var, comp_arm)),
      names = list(arm_var = as.name(arm_var)),
      others = list(
        ref_arm = ref_arm,
        comp_arm = comp_arm
      )
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      parent <- parent_list,
      env = list(
        parent_list = pipe_expr(parent_list)
      )
    )
  )

  y$data <- bracket_expr(data_list)

  # Tabulate subgroup analysis of response.
  summary_list <- list()

  summary_list <- add_expr(
    summary_list,
    substitute(
      expr = df <- extract_survival_subgroups(
        variables = list(
          tte = aval_var,
          is_event = "is_event",
          arm = arm_var,
          subgroups = subgroup_var,
          strata = strata_var
        ),
        control = control_coxph(conf_level = conf_level),
        data = anl
      ),
      env = list(
        aval_var = aval_var,
        arm_var = arm_var,
        subgroup_var = subgroup_var,
        strata_var = strata_var,
        conf_level = conf_level
      )
    )
  )

  y$summary <- bracket_expr(summary_list)

  # Table output.
  y$table <- substitute(
    expr = {
      result <- rtables::basic_table() %>%
        tabulate_survival_subgroups(
          df,
          vars = stats,
          time_unit = as.character(anl$time_unit_var[1]),
          riskdiff = riskdiff
        )
    },
    env = list(stats = stats, time_unit_var = as.name(time_unit_var), riskdiff = riskdiff)
  )

  all_ggplot2_args <- teal.widgets::resolve_ggplot2_args(
    user_plot = ggplot2_args,
    module_plot = teal.widgets::ggplot2_args(
      labs = list(
        title = paste(
          paste("Forest Plot of Survival Duration for", obj_var_name),
          ifelse(is.null(strata_var), "", paste("Stratified by", paste(strata_var, collapse = " and "))),
          sep = "\n"
        ),
        caption = ""
      )
    )
  )

  plot_list <- list()

  plot_list <- add_expr(
    plot_list,
    substitute(
      expr = {
        f <- g_forest(
          tbl = result,
          col_symbol_size = col_s_size,
          font_size = font_size,
          as_list = TRUE
        )
      },
      env = list(
        col_s_size = col_symbol_size,
        font_size = font_size
      )
    )
  )

  plot_list <- add_expr(
    plot_list,
    substitute(
      expr = {
        p <- cowplot::plot_grid(
          f[["table"]] + ggplot2::labs(title = ggplot2_args_title, subtitle = ggplot2_args_subtitle),
          f[["plot"]] + ggplot2::labs(caption = ggplot2_args_caption),
          align = "h",
          axis = "tblr",
          rel_widths = c(1 - rel_width_forest, rel_width_forest)
        )
      },
      env = list(
        rel_width_forest = rel_width_forest,
        ggplot2_args_title = all_ggplot2_args$labs$title,
        ggplot2_args_subtitle = all_ggplot2_args$labs$subtitle,
        ggplot2_args_caption = all_ggplot2_args$labs$caption
      )
    )
  )

  # Plot output.
  y$plot <- plot_list

  y
}

#' teal Module: Forest Survival Plot
#'
#' This module produces a grid-style forest plot for time-to-event data with ADaM structure.
#'
#' @inheritParams tern::g_forest
#' @inheritParams module_arguments
#' @inheritParams template_forest_tte
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' library(nestcolor)
#'
#' ADSL <- tmc_ex_adsl
#' ADTTE <- tmc_ex_adtte
#' ADSL$RACE <- droplevels(ADSL$RACE) %>% with_label("Race")
#'
#' arm_ref_comp <- list(
#'   ARM = list(
#'     ref = "B: Placebo",
#'     comp = c("A: Drug X", "C: Combination")
#'   ),
#'   ARMCD = list(
#'     ref = "ARM B",
#'     comp = c("ARM A", "ARM C")
#'   )
#' )
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADTTE = ADTTE,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADTTE <- tmc_ex_adtte
#'       ADSL$RACE <- droplevels(ADSL$RACE) %>% with_label(\"Race\")
#'     "
#'   ),
#'   modules = modules(
#'     tm_g_forest_tte(
#'       label = "Forest Survival",
#'       dataname = "ADTTE",
#'       arm_var = choices_selected(
#'         variable_choices(ADSL, c("ARM", "ARMCD")),
#'         "ARMCD"
#'       ),
#'       arm_ref_comp = arm_ref_comp,
#'       paramcd = choices_selected(
#'         value_choices(ADTTE, "PARAMCD", "PARAM"),
#'         "OS"
#'       ),
#'       subgroup_var = choices_selected(
#'         variable_choices(ADSL, names(ADSL)),
#'         c("BMRKR2", "SEX")
#'       ),
#'       strata_var = choices_selected(
#'         variable_choices(ADSL, c("STRATA1", "STRATA2")),
#'         "STRATA2"
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_g_forest_tte <- function(label,
                            dataname,
                            parentname = ifelse(
                              inherits(arm_var, "data_extract_spec"),
                              teal.transform::datanames_input(arm_var),
                              "ADSL"
                            ),
                            arm_var,
                            arm_ref_comp = NULL,
                            subgroup_var,
                            paramcd,
                            strata_var,
                            aval_var = teal.transform::choices_selected(
                              teal.transform::variable_choices(dataname, "AVAL"), "AVAL",
                              fixed = TRUE
                            ),
                            cnsr_var = teal.transform::choices_selected(
                              teal.transform::variable_choices(dataname, "CNSR"), "CNSR",
                              fixed = TRUE
                            ),
                            stats = c("n_tot_events", "n_events", "median", "hr", "ci"),
                            riskdiff = NULL,
                            conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE),
                            time_unit_var = teal.transform::choices_selected(
                              teal.transform::variable_choices(dataname, "AVALU"), "AVALU",
                              fixed = TRUE
                            ),
                            fixed_symbol_size = TRUE,
                            plot_height = c(500L, 200L, 2000L),
                            plot_width = c(1500L, 800L, 3000L),
                            rel_width_forest = c(25L, 0L, 100L),
                            font_size = c(15L, 1L, 30L),
                            pre_output = NULL,
                            post_output = NULL,
                            ggplot2_args = teal.widgets::ggplot2_args()) {
  message("Initializing tm_g_forest_tte")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(subgroup_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(strata_var, "choices_selected")
  checkmate::assert_class(aval_var, "choices_selected")
  checkmate::assert_class(cnsr_var, "choices_selected")
  checkmate::assert_class(conf_level, "choices_selected")
  checkmate::assert_class(time_unit_var, "choices_selected")
  checkmate::assert_character(stats, min.len = 3)
  checkmate::assert_true(any(c("n_tot", "n_tot_events") %in% stats))
  checkmate::assert_true(all(c("hr", "ci") %in% stats))
  checkmate::assert_list(riskdiff, null.ok = TRUE)
  checkmate::assert_flag(fixed_symbol_size)
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(ggplot2_args, "ggplot2_args")

  args <- as.list(environment())

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname),
    aval_var = cs_to_des_select(aval_var, dataname = dataname),
    cnsr_var = cs_to_des_select(cnsr_var, dataname = dataname),
    subgroup_var = cs_to_des_select(subgroup_var, dataname = parentname, multiple = TRUE, ordered = TRUE),
    strata_var = cs_to_des_select(strata_var, dataname = parentname, multiple = TRUE),
    time_unit_var = cs_to_des_select(time_unit_var, dataname = dataname)
  )

  module(
    label = label,
    server = srv_g_forest_tte,
    ui = ui_g_forest_tte,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        arm_ref_comp = arm_ref_comp,
        parentname = parentname,
        stats = stats,
        riskdiff = riskdiff,
        plot_height = plot_height,
        plot_width = plot_width,
        ggplot2_args = ggplot2_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_g_forest_tte <- function(id, ...) {
  a <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$arm_var,
    a$paramcd,
    a$subgroup_var,
    a$strata_var,
    a$aval_var,
    a$cnsr_var,
    a$time_unit_var
  )

  ns <- NS(id)

  teal.widgets::standard_layout(
    output = teal.widgets::plot_with_settings_ui(id = ns("myplot")),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c("arm_var", "paramcd", "subgroup_var", "strata_var", "aval_var", "cnsr_var")]),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select Endpoint",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("aval_var"),
        label = "Analysis Variable",
        data_extract_spec = a$aval_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("cnsr_var"),
        label = "Censor Variable",
        data_extract_spec = a$cnsr_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      uiOutput(
        ns("arms_buckets"),
        title = paste(
          "Multiple reference groups are automatically combined into a single group when more than one",
          "value is selected."
        )
      ),
      teal.transform::data_extract_ui(
        id = ns("subgroup_var"),
        label = "Subgroup Variables",
        data_extract_spec = a$subgroup_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("strata_var"),
        label = "Stratify by",
        data_extract_spec = a$strata_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional plot settings",
          teal.widgets::optionalSelectInput(
            ns("conf_level"),
            "Level of Confidence",
            a$conf_level$choices,
            a$conf_level$selected,
            multiple = FALSE,
            fixed = a$conf_level$fixed
          ),
          checkboxInput(ns("fixed_symbol_size"), "Fixed symbol size", value = TRUE),
          teal.transform::data_extract_ui(
            id = ns("time_unit_var"),
            label = "Time Unit Variable",
            data_extract_spec = a$time_unit_var,
            is_single_dataset = is_single_dataset_value
          ),
          teal.widgets::optionalSliderInputValMinMax(
            ns("rel_width_forest"),
            "Relative Width of Forest Plot (%)",
            a$rel_width_forest,
            ticks = FALSE, step = 1
          ),
          teal.widgets::optionalSliderInputValMinMax(
            ns("font_size"),
            "Table Font Size",
            a$font_size,
            ticks = FALSE, step = 1
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_g_forest_tte <- function(id,
                             data,
                             reporter,
                             filter_panel_api,
                             dataname,
                             parentname,
                             arm_var,
                             arm_ref_comp,
                             paramcd,
                             subgroup_var,
                             strata_var,
                             aval_var,
                             cnsr_var,
                             time_unit_var,
                             stats,
                             riskdiff,
                             plot_height,
                             plot_width,
                             ggplot2_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    # Setup arm variable selection, default reference arms, and default
    # comparison arms for encoding panel
    iv_arm_ref <- arm_ref_comp_observer(
      session,
      input,
      output,
      id_arm_var = extract_input("arm_var", parentname),
      data = data()[[parentname]],
      arm_ref_comp = arm_ref_comp,
      module = "tm_g_forest_tte"
    )

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        arm_var = arm_var,
        paramcd = paramcd,
        subgroup_var = subgroup_var,
        strata_var = strata_var,
        aval_var = aval_var,
        cnsr_var = cnsr_var,
        time_unit_var = time_unit_var
      ),
      datasets = data,
      select_validation_rule = list(
        aval_var = shinyvalidate::sv_required("An analysis variable is required"),
        cnsr_var = shinyvalidate::sv_required("A censor variable is required"),
        arm_var = shinyvalidate::sv_required("A treatment variable is required")
      ),
      filter_validation_rule = list(paramcd = shinyvalidate::sv_required(message = "Please select Endpoint filter."))
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level"))
      iv$add_rule(
        "conf_level",
        shinyvalidate::sv_between(0, 1, message_fmt = "Confidence level must be between 0 and 1")
      )
      iv$add_validator(iv_arm_ref)
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var, subgroup_var = subgroup_var, strata_var = strata_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    validate_checks <- reactive({
      teal::validate_inputs(iv_r())
      adsl_filtered <- anl_q()[[parentname]]
      anl_filtered <- anl_q()[[dataname]]
      anl <- anl_q()[["ANL"]]

      anl_m <- anl_inputs()
      input_arm_var <- as.vector(anl_m$columns_source$arm_var)
      input_aval_var <- as.vector(anl_m$columns_source$aval_var)
      input_cnsr_var <- as.vector(anl_m$columns_source$cnsr_var)
      input_subgroup_var <- as.vector(anl_m$columns_source$subgroup_var)
      input_strata_var <- as.vector(anl_m$columns_source$strata_var)
      input_time_unit_var <- as.vector(anl_m$columns_source$time_unit_var)
      input_paramcd <- unlist(paramcd$filter)["vars_selected"]

      # validate inputs
      validate_args <- list(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var, input_subgroup_var, input_strata_var),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_paramcd, input_aval_var, input_cnsr_var, input_time_unit_var),
        arm_var = input_arm_var
      )

      # validate arm levels
      if (length(input_arm_var) > 0 && length(unique(adsl_filtered[[input_arm_var]])) == 1) {
        validate_args <- append(validate_args, list(min_n_levels_armvar = NULL))
      }
      validate_args <- append(
        validate_args, list(ref_arm = unlist(input$buckets$Ref), comp_arm = unlist(input$buckets$Comp))
      )

      if (length(input_subgroup_var) > 0) {
        validate(
          need(
            all(vapply(adsl_filtered[, input_subgroup_var], is.factor, logical(1))),
            "Not all subgroup variables are factors."
          )
        )
      }

      if (length(input_strata_var) > 0) {
        validate(
          need(
            all(vapply(adsl_filtered[, input_strata_var], is.factor, logical(1))),
            "Not all stratification variables are factors."
          )
        )
      }

      do.call(what = "validate_standard_inputs", validate_args)

      validate(need(
        length(anl[[input_paramcd]]) > 0,
        "Value of the endpoint variable should not be empty."
      ))

      NULL
    })

    # The R-code corresponding to the analysis.
    all_q <- reactive({
      validate_checks()

      anl_m <- anl_inputs()

      strata_var <- as.vector(anl_m$columns_source$strata_var)
      subgroup_var <- as.vector(anl_m$columns_source$subgroup_var)

      obj_var_name <- get_g_forest_obj_var_name(paramcd, input)

      my_calls <- template_forest_tte(
        dataname = "ANL",
        parentname = "ANL_ADSL",
        arm_var = as.vector(anl_m$columns_source$arm_var),
        ref_arm = unlist(input$buckets$Ref),
        comp_arm = unlist(input$buckets$Comp),
        obj_var_name = obj_var_name,
        aval_var = as.vector(anl_m$columns_source$aval_var),
        cnsr_var = as.vector(anl_m$columns_source$cnsr_var),
        subgroup_var = if (length(subgroup_var) != 0) subgroup_var else NULL,
        strata_var = if (length(strata_var) != 0) strata_var else NULL,
        stats = stats,
        riskdiff = riskdiff,
        conf_level = as.numeric(input$conf_level),
        col_symbol_size = if (!input$fixed_symbol_size) 1,
        time_unit_var = as.vector(anl_m$columns_source$time_unit_var),
        rel_width_forest = input$rel_width_forest / 100,
        font_size = input$font_size,
        ggplot2_args = ggplot2_args
      )
      teal.code::eval_code(anl_q(), as.expression(my_calls))
    })

    # Outputs to render.
    plot_r <- reactive(all_q()[["p"]])

    pws <- teal.widgets::plot_with_settings_srv(
      id = "myplot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = "R Code for the Current Time-to-Event Forest Plot"
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Forest Survival Plot",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Plot", "header3")
        card$append_plot(plot_r(), dim = pws$dim())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Patient Profile Medical History
#'
#' Creates a valid expression to generate a patient profile medical history report using ADaM datasets.
#'
#' @inheritParams template_arguments
#' @param mhterm (`character`)\cr name of the reported term for the medical history variable.
#' @param mhbodsys (`character`)\cr name of the body system or organ class variable.
#' @param mhdistat (`character`)\cr name of the status of the disease variable.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_pp_medical_history()]
#'
#' @keywords internal
template_medical_history <- function(dataname = "ANL",
                                     mhterm = "MHTERM",
                                     mhbodsys = "MHBODSYS",
                                     mhdistat = "MHDISTAT",
                                     patient_id = NULL) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(mhterm)
  checkmate::assert_string(mhbodsys)
  checkmate::assert_string(mhdistat)

  y <- list()
  y$table <- list()

  table_list <- add_expr(
    list(),
    substitute(expr = {
      labels <- teal.data::col_labels(dataname, fill = FALSE)[c(mhbodsys_char, mhterm_char, mhdistat_char)]
      mhbodsys_label <- labels[mhbodsys_char]

      result_raw <-
        dataname %>%
        dplyr::select(mhbodsys, mhterm, mhdistat) %>%
        dplyr::arrange(mhbodsys) %>%
        dplyr::mutate_if(is.character, as.factor) %>%
        dplyr::mutate_if(is.factor, function(x) explicit_na(x, "UNKNOWN")) %>%
        dplyr::distinct() %>%
        `colnames<-`(labels)

      result <- rtables::basic_table() %>%
        rtables::split_cols_by_multivar(colnames(result_raw)[2:3]) %>%
        rtables::split_rows_by(
          colnames(result_raw)[1],
          split_fun = rtables::drop_split_levels
        ) %>%
        rtables::split_rows_by(
          colnames(result_raw)[2],
          split_fun = rtables::drop_split_levels,
          child_labels = "hidden"
        ) %>%
        rtables::analyze_colvars(function(x) x[seq_along(x)]) %>%
        rtables::build_table(result_raw)

      main_title(result) <- paste("Patient ID:", patient_id)

      result
    }, env = list(
      dataname = as.name(dataname),
      mhbodsys = as.name(mhbodsys),
      mhterm = as.name(mhterm),
      mhdistat = as.name(mhdistat),
      mhbodsys_char = mhbodsys,
      mhterm_char = mhterm,
      mhdistat_char = mhdistat,
      patient_id = patient_id
    ))
  )

  y$table <- bracket_expr(table_list)

  y
}

#' teal Module: Patient Profile Medical History
#'
#' This module produces a patient profile medical history report using ADaM datasets.
#'
#' @inheritParams module_arguments
#' @inheritParams template_medical_history
#' @param mhterm ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `MHTERM` variable from `dataname`.
#' @param mhbodsys ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `MHBODSYS` variable from `dataname`.
#' @param mhdistat ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `MHDISTAT` variable from `dataname`.
#'
#' @inherit module_arguments return
#'
#' @examples
#' ADSL <- tmc_ex_adsl
#' ADMH <- tmc_ex_admh
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADMH = ADMH,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADMH <- tmc_ex_admh
#'     "
#'   ),
#'   modules = modules(
#'     tm_t_pp_medical_history(
#'       label = "Medical History",
#'       dataname = "ADMH",
#'       parentname = "ADSL",
#'       patient_col = "USUBJID",
#'       mhterm = choices_selected(
#'         choices = variable_choices(ADMH, c("MHTERM")),
#'         selected = "MHTERM"
#'       ),
#'       mhbodsys = choices_selected(
#'         choices = variable_choices(ADMH, "MHBODSYS"),
#'         selected = "MHBODSYS"
#'       ),
#'       mhdistat = choices_selected(
#'         choices = variable_choices(ADMH, "MHDISTAT"),
#'         selected = "MHDISTAT"
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_pp_medical_history <- function(label,
                                    dataname = "ADMH",
                                    parentname = "ADSL",
                                    patient_col = "USUBJID",
                                    mhterm = NULL,
                                    mhbodsys = NULL,
                                    mhdistat = NULL,
                                    pre_output = NULL,
                                    post_output = NULL) {
  message("Initializing tm_t_pp_medical_history")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(patient_col)
  checkmate::assert_class(mhterm, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(mhbodsys, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(mhdistat, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)

  args <- as.list(environment())
  data_extract_list <- list(
    mhterm = `if`(is.null(mhterm), NULL, cs_to_des_select(mhterm, dataname = dataname)),
    mhbodsys = `if`(is.null(mhbodsys), NULL, cs_to_des_select(mhbodsys, dataname = dataname)),
    mhdistat = `if`(is.null(mhdistat), NULL, cs_to_des_select(mhdistat, dataname = dataname))
  )

  module(
    label = label,
    ui = ui_t_medical_history,
    ui_args = c(data_extract_list, args),
    server = srv_t_medical_history,
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        patient_col = patient_col
      )
    ),
    datanames = c(dataname, parentname)
  )
}

#' @keywords internal
ui_t_medical_history <- function(id, ...) {
  ui_args <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    ui_args$mhterm,
    ui_args$mhbodsys,
    ui_args$mhdistat
  )

  ns <- NS(id)
  teal.widgets::standard_layout(
    output = tags$div(
      teal.widgets::table_with_settings_ui(ns("table"))
    ),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(ui_args[c("mhterm", "mhbodsys", "mhdistat")]),
      teal.widgets::optionalSelectInput(
        ns("patient_id"),
        "Select Patient:",
        multiple = FALSE,
        options = shinyWidgets::pickerOptions(`liveSearch` = TRUE)
      ),
      teal.transform::data_extract_ui(
        id = ns("mhterm"),
        label = "Select MHTERM variable:",
        data_extract_spec = ui_args$mhterm,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("mhbodsys"),
        label = "Select MHBODSYS variable:",
        data_extract_spec = ui_args$mhbodsys,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("mhdistat"),
        label = "Select MHDISTAT variable:",
        data_extract_spec = ui_args$mhdistat,
        is_single_dataset = is_single_dataset_value
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = ui_args$pre_output,
    post_output = ui_args$post_output
  )
}

#' @keywords internal
srv_t_medical_history <- function(id,
                                  data,
                                  reporter,
                                  filter_panel_api,
                                  dataname,
                                  parentname,
                                  patient_col,
                                  mhterm,
                                  mhbodsys,
                                  mhdistat,
                                  label) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    patient_id <- reactive(input$patient_id)

    # Init
    patient_data_base <- reactive(unique(data()[[parentname]][[patient_col]]))
    teal.widgets::updateOptionalSelectInput(
      session, "patient_id",
      choices = patient_data_base(), selected = patient_data_base()[1]
    )

    observeEvent(patient_data_base(),
      handlerExpr = {
        teal.widgets::updateOptionalSelectInput(
          session,
          "patient_id",
          choices = patient_data_base(),
          selected = if (length(patient_data_base()) == 1) {
            patient_data_base()
          } else {
            intersect(patient_id(), patient_data_base())
          }
        )
      },
      ignoreInit = TRUE
    )

    # Medical history tab ----
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(mhterm = mhterm, mhbodsys = mhbodsys, mhdistat = mhdistat),
      datasets = data,
      select_validation_rule = list(
        mhterm = shinyvalidate::sv_required("Please select MHTERM variable."),
        mhbodsys = shinyvalidate::sv_required("Please select MHBODSYS variable."),
        mhdistat = shinyvalidate::sv_required("Please select MHDISTAT variable.")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient"))
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::left_join"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr))
    })

    all_q <- reactive({
      teal::validate_inputs(iv_r())

      validate(
        need(
          nrow(anl_q()[["ANL"]][anl_q()[["ANL"]][[patient_col]] == patient_id(), ]) > 0,
          "Patient has no data about medical history."
        )
      )

      my_calls <- template_medical_history(
        dataname = "ANL",
        mhterm = input[[extract_input("mhterm", dataname)]],
        mhbodsys = input[[extract_input("mhbodsys", dataname)]],
        mhdistat = input[[extract_input("mhdistat", dataname)]],
        patient_id = patient_id()
      )

      teal.code::eval_code(
        anl_q(),
        substitute(
          expr = {
            ANL <- ANL[ANL[[patient_col]] == patient_id, ]
          }, env = list(
            patient_col = patient_col,
            patient_id = patient_id()
          )
        )
      ) %>%
        teal.code::eval_code(as.expression(my_calls))
    })

    table_r <- reactive(all_q()[["result"]])

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Patient Medical History Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Patient Profile Prior Medication
#'
#' Creates a valid expression to generate a patient profile prior medication report using ADaM datasets.
#'
#' @inheritParams template_arguments
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_pp_prior_medication()]
#'
#' @keywords internal
template_prior_medication <- function(dataname = "ANL",
                                      atirel = "ATIREL",
                                      cmdecod = "CMDECOD",
                                      cmindc = "CMINDC",
                                      cmstdy = "CMSTDY") {
  checkmate::assert_string(dataname)
  checkmate::assert_string(atirel)
  checkmate::assert_string(cmdecod)
  checkmate::assert_string(cmindc)
  checkmate::assert_string(cmstdy)

  y <- list()
  y$table <- list()

  table_list <- add_expr(
    list(),
    substitute(expr = {
      result <-
        dataname %>%
        dplyr::filter(atirel %in% c("PRIOR", "PRIOR_CONCOMITANT")) %>%
        dplyr::select(cmindc, cmdecod, cmstdy) %>%
        dplyr::filter(!is.na(cmdecod)) %>%
        dplyr::distinct() %>%
        `colnames<-`(col_labels(dataname, fill = TRUE)[c(cmindc_char, cmdecod_char, cmstdy_char)])
      result
    }, env = list(
      dataname = as.name(dataname),
      atirel = as.name(atirel),
      cmdecod = as.name(cmdecod),
      cmindc = as.name(cmindc),
      cmstdy = as.name(cmstdy),
      atirel_char = atirel,
      cmdecod_char = cmdecod,
      cmindc_char = cmindc,
      cmstdy_char = cmstdy
    ))
  )
  # Note: l_html_concomitant_adcm is still not included since one column is available out of 9

  y$table <- bracket_expr(table_list)
  y
}

#' teal Module: Patient Profile Prior Medication
#'
#' This module produces a patient profile prior medication report using ADaM datasets.
#'
#' @inheritParams module_arguments
#' @inheritParams template_prior_medication
#'
#' @inherit module_arguments return
#'
#' @examples
#' library(dplyr)
#'
#' ADCM <- tmc_ex_adcm
#' ADSL <- tmc_ex_adsl %>% filter(USUBJID %in% ADCM$USUBJID)
#' ADCM$CMASTDTM <- ADCM$ASTDTM
#' ADCM$CMAENDTM <- ADCM$AENDTM
#' adcm_keys <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4")
#'
#' join_keys <- default_cdisc_join_keys[c("ADSL", "ADCM")]
#' join_keys["ADCM", "ADCM"] <- adcm_keys
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADCM = ADCM,
#'     code = "
#'       ADCM <- tmc_ex_adcm
#'       ADSL <- tmc_ex_adsl %>% filter(USUBJID %in% ADCM$USUBJID)
#'       ADCM$CMASTDTM <- ADCM$ASTDTM
#'       ADCM$CMAENDTM <- ADCM$AENDTM
#'     ",
#'     join_keys = join_keys
#'   ),
#'   modules = modules(
#'     tm_t_pp_prior_medication(
#'       label = "Prior Medication",
#'       dataname = "ADCM",
#'       parentname = "ADSL",
#'       patient_col = "USUBJID",
#'       atirel = choices_selected(
#'         choices = variable_choices(ADCM, "ATIREL"),
#'         selected = "ATIREL"
#'       ),
#'       cmdecod = choices_selected(
#'         choices = variable_choices(ADCM, "CMDECOD"),
#'         selected = "CMDECOD"
#'       ),
#'       cmindc = choices_selected(
#'         choices = variable_choices(ADCM, "CMINDC"),
#'         selected = "CMINDC"
#'       ),
#'       cmstdy = choices_selected(
#'         choices = variable_choices(ADCM, "ASTDY"),
#'         selected = "ASTDY"
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_pp_prior_medication <- function(label,
                                     dataname = "ADCM",
                                     parentname = "ADSL",
                                     patient_col = "USUBJID",
                                     atirel = NULL,
                                     cmdecod = NULL,
                                     cmindc = NULL,
                                     cmstdy = NULL,
                                     pre_output = NULL,
                                     post_output = NULL) {
  message("Initializing tm_t_pp_prior_medication")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(patient_col)
  checkmate::assert_class(atirel, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(cmdecod, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(cmindc, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(cmstdy, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)

  args <- as.list(environment())
  data_extract_list <- list(
    atirel = `if`(is.null(atirel), NULL, cs_to_des_select(atirel, dataname = dataname)),
    cmdecod = `if`(is.null(cmdecod), NULL, cs_to_des_select(cmdecod, dataname = dataname)),
    cmindc = `if`(is.null(cmindc), NULL, cs_to_des_select(cmindc, dataname = dataname)),
    cmstdy = `if`(is.null(cmstdy), NULL, cs_to_des_select(cmstdy, dataname = dataname))
  )

  module(
    label = label,
    ui = ui_t_prior_medication,
    ui_args = c(data_extract_list, args),
    server = srv_t_prior_medication,
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        patient_col = patient_col
      )
    ),
    datanames = c(dataname, parentname)
  )
}

#' @keywords internal
ui_t_prior_medication <- function(id, ...) {
  ui_args <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    ui_args$atirel,
    ui_args$cmdecod,
    ui_args$cmindc,
    ui_args$cmstdy
  )

  ns <- NS(id)
  teal.widgets::standard_layout(
    output = tags$div(
      DT::DTOutput(outputId = ns("prior_medication_table"))
    ),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(ui_args[c("atirel", "cmdecod", "cmindc", "cmstdy")]),
      teal.widgets::optionalSelectInput(
        ns("patient_id"),
        "Select Patient:",
        multiple = FALSE,
        options = shinyWidgets::pickerOptions(`liveSearch` = TRUE)
      ),
      teal.transform::data_extract_ui(
        id = ns("cmdecod"),
        label = "Select the medication decoding column:",
        data_extract_spec = ui_args$cmdecod,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("atirel"),
        label = "Select ATIREL variable:",
        data_extract_spec = ui_args$atirel,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("cmindc"),
        label = "Select CMINDC variable:",
        data_extract_spec = ui_args$cmindc,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("cmstdy"),
        label = "Select CMSTDY variable:",
        data_extract_spec = ui_args$cmstdy,
        is_single_dataset = is_single_dataset_value
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = ui_args$pre_output,
    post_output = ui_args$post_output
  )
}

#' @keywords internal
srv_t_prior_medication <- function(id,
                                   data,
                                   reporter,
                                   filter_panel_api,
                                   dataname,
                                   parentname,
                                   patient_col,
                                   atirel,
                                   cmdecod,
                                   cmindc,
                                   cmstdy,
                                   label) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    patient_id <- reactive(input$patient_id)

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        atirel = atirel,
        cmdecod = cmdecod,
        cmindc = cmindc,
        cmstdy = cmstdy
      ),
      datasets = data,
      select_validation_rule = list(
        atirel = shinyvalidate::sv_required("An ATIREL variable is required"),
        cmdecod = shinyvalidate::sv_required("A medication decoding variable is required"),
        cmindc = shinyvalidate::sv_required("A CMINDC variable is required"),
        cmstdy = shinyvalidate::sv_required("A CMSTDY variable is required")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("patient_id", shinyvalidate::sv_required("Please select patient id"))
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    # Init
    patient_data_base <- reactive(unique(data()[[parentname]][[patient_col]]))
    teal.widgets::updateOptionalSelectInput(
      session,
      "patient_id",
      choices = patient_data_base(),
      selected = patient_data_base()[1]
    )

    observeEvent(patient_data_base(),
      handlerExpr = {
        teal.widgets::updateOptionalSelectInput(
          session,
          "patient_id",
          choices = patient_data_base(),
          selected = if (length(patient_data_base()) == 1) {
            patient_data_base()
          } else {
            intersect(patient_id(), patient_data_base())
          }
        )
      },
      ignoreInit = TRUE
    )

    # Prior medication tab ----
    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::left_join"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr))
    })

    all_q <- reactive({
      teal::validate_inputs(iv_r())

      my_calls <- template_prior_medication(
        dataname = "ANL",
        atirel = input[[extract_input("atirel", dataname)]],
        cmdecod = input[[extract_input("cmdecod", dataname)]],
        cmindc = input[[extract_input("cmindc", dataname)]],
        cmstdy = input[[extract_input("cmstdy", dataname)]]
      )

      anl_q() %>%
        teal.code::eval_code(
          substitute(
            expr = {
              ANL <- ANL[ANL[[patient_col]] == patient_id, ]
            }, env = list(
              patient_col = patient_col,
              patient_id = patient_id()
            )
          )
        ) %>%
        teal.code::eval_code(as.expression(my_calls))
    })

    table_r <- reactive(all_q()[["result"]])

    output$prior_medication_table <- DT::renderDataTable(
      expr = table_r(),
      options = list(
        lengthMenu = list(list(-1, 5, 10, 25), list("All", "5", "10", "25"))
      )
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Patient Prior Medication Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Patient Profile Basic Info
#'
#' Creates a valid expression to generate a patient profile basic info report using ADaM datasets.
#'
#' @inheritParams template_arguments
#' @param vars (`character`)\cr names of the variables to be shown in the table.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_pp_basic_info()]
#'
#' @keywords internal
template_basic_info <- function(dataname = "ANL",
                                vars,
                                patient_id = NULL) {
  checkmate::assert_string(dataname)
  checkmate::assert_character(vars, min.len = 1)

  y <- list()
  y$table <- list()

  table_list <- add_expr(
    list(),
    substitute(
      expr = {
        values <- dataname %>%
          dplyr::select(vars) %>%
          # we are sure that only one row
          utils::head(1) %>%
          t()

        key <- col_labels(dataname, fill = TRUE)[rownames(values)]

        result <-
          data.frame(var = rownames(values), key = key, value = values) %>%
          dplyr::select(var, key, value) %>%
          dplyr::rename(` ` = var, `  ` = key, `   ` = value)

        result <- rlistings::as_listing(
          result,
          default_formatting = list(all = fmt_config(align = "left"))
        )
        main_title(result) <- paste("Patient ID:", patient_id)

        result
      }, env = list(
        dataname = as.name(dataname),
        vars = vars,
        patient_id = patient_id
      )
    )
  )
  y$table <- bracket_expr(table_list)

  y
}

#' teal Module: Patient Profile Basic Info
#'
#' This module produces a patient profile basic info report using ADaM datasets.
#'
#' @inheritParams module_arguments
#' @inheritParams template_basic_info
#' @param vars ([teal.transform::choices_selected()])\cr  object with all
#'   available choices and preselected option for variables from `dataname` to show in the table.
#'
#' @inherit module_arguments return
#'
#' @examples
#' ADSL <- tmc_ex_adsl
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     code = "ADSL <- tmc_ex_adsl"
#'   ),
#'   modules = modules(
#'     tm_t_pp_basic_info(
#'       label = "Basic Info",
#'       dataname = "ADSL",
#'       patient_col = "USUBJID",
#'       vars = choices_selected(
#'         choices = variable_choices(ADSL),
#'         selected = c("ARM", "AGE", "SEX", "COUNTRY", "RACE", "EOSSTT")
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_pp_basic_info <- function(label,
                               dataname = "ADSL",
                               patient_col = "USUBJID",
                               vars = NULL,
                               pre_output = NULL,
                               post_output = NULL) {
  message("Initializing tm_t_pp_basic_info")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(patient_col)
  checkmate::assert_class(vars, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)

  args <- as.list(environment())
  data_extract_list <- list(
    vars = `if`(is.null(vars), NULL, cs_to_des_select(vars, dataname = dataname, multiple = TRUE))
  )

  module(
    label = label,
    ui = ui_t_basic_info,
    ui_args = c(data_extract_list, args),
    server = srv_t_basic_info,
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        label = label,
        patient_col = patient_col
      )
    ),
    datanames = dataname
  )
}

#' @keywords internal
ui_t_basic_info <- function(id, ...) {
  ui_args <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(ui_args$vars)

  ns <- NS(id)
  teal.widgets::standard_layout(
    output = tags$div(
      htmlOutput(ns("title")),
      DT::DTOutput(outputId = ns("basic_info_table"))
    ),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(ui_args[c("vars")]),
      teal.widgets::optionalSelectInput(
        ns("patient_id"),
        "Select Patient:",
        multiple = FALSE,
        options = shinyWidgets::pickerOptions(`liveSearch` = TRUE)
      ),
      teal.transform::data_extract_ui(
        id = ns("vars"),
        label = "Select variable:",
        data_extract_spec = ui_args$vars,
        is_single_dataset = is_single_dataset_value
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = ui_args$pre_output,
    post_output = ui_args$post_output
  )
}

#' @keywords internal
srv_t_basic_info <- function(id,
                             data,
                             reporter,
                             filter_panel_api,
                             dataname,
                             patient_col,
                             vars,
                             label) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    patient_id <- reactive(input$patient_id)

    # Init
    patient_data_base <- reactive(unique(data()[[dataname]][[patient_col]]))
    teal.widgets::updateOptionalSelectInput(
      session,
      "patient_id",
      choices = patient_data_base(),
      selected = patient_data_base()[1]
    )

    observeEvent(patient_data_base(),
      handlerExpr = {
        teal.widgets::updateOptionalSelectInput(
          session,
          "patient_id",
          choices = patient_data_base(),
          selected = if (length(patient_data_base()) == 1) {
            patient_data_base()
          } else {
            intersect(patient_id(), patient_data_base())
          }
        )
      },
      ignoreInit = TRUE
    )

    # Basic Info tab ----
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(vars = vars),
      datasets = data,
      select_validation_rule = list(
        vars = shinyvalidate::sv_required("Please select basic info variables")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient"))
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::left_join"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr))
    })

    all_q <- reactive({
      teal::validate_inputs(iv_r())
      my_calls <- template_basic_info(
        dataname = "ANL",
        vars = anl_inputs()$columns_source$vars,
        patient_id = patient_id()
      )

      teal.code::eval_code(
        anl_q(),
        substitute(
          expr = {
            pt_id <- patient_id
            ANL <- ANL[ANL[[patient_col]] == patient_id, ]
          }, env = list(
            patient_col = patient_col,
            patient_id = patient_id()
          )
        )
      ) %>%
        teal.code::eval_code(as.expression(my_calls))
    })

    output$title <- renderText({
      paste("<h5><b>Patient ID:", all_q()[["pt_id"]], "</b></h5>")
    })

    table_r <- reactive(all_q()[["result"]])

    output$basic_info_table <- DT::renderDataTable(
      expr = table_r(),
      options = list(
        lengthMenu = list(list(-1, 5, 10, 25), list("All", "5", "10", "25"))
      )
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Patient Profile Basic Info Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Shift by Arm by Worst Analysis Indicator Level
#'
#' Creates a valid expression to generate a summary table of worst analysis indicator variable level per subject by arm.
#'
#' @inheritParams template_shift_by_arm
#' @inheritParams template_arguments
#' @param worst_flag (`character`)\cr value indicating worst analysis indicator level.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_shift_by_arm()]
#'
#' @keywords internal
template_shift_by_arm_by_worst <- function(dataname,
                                           parentname,
                                           arm_var = "ARM",
                                           paramcd = "PARAMCD",
                                           worst_flag_var = "WORS02FL",
                                           worst_flag = "Y",
                                           treatment_flag_var = "ONTRTFL",
                                           treatment_flag = "Y",
                                           aval_var = "ANRIND",
                                           base_var = lifecycle::deprecated(),
                                           baseline_var = "BNRIND",
                                           na.rm = FALSE, # nolint: object_name.
                                           na_level = default_na_str(),
                                           add_total = FALSE,
                                           total_label = default_total_label(),
                                           basic_table_args = teal.widgets::basic_table_args()) {
  if (lifecycle::is_present(base_var)) {
    baseline_var <- base_var
    warning(
      "The `base_var` argument of `template_shift_by_arm_by_worst()` ",
      "is deprecated as of teal.modules.clinical 0.8.16. ",
      "Please use the `baseline_var` argument instead.",
      call. = FALSE
    )
  }

  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(arm_var)
  checkmate::assert_character(worst_flag_var, null.ok = TRUE)
  checkmate::assert_string(paramcd)
  checkmate::assert_string(aval_var)
  checkmate::assert_string(baseline_var)
  checkmate::assert_flag(na.rm)
  checkmate::assert_string(na_level)
  checkmate::assert_string(treatment_flag_var)
  checkmate::assert_string(treatment_flag)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)

  y <- list()

  # Start data steps.
  data_list <- list()
  data_list <- add_expr(
    data_list,
    substitute(
      expr = parentname <- df_explicit_na(parentname, na_level = na_str),
      env = list(parentname = as.name(parentname), na_str = na_level)
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = dataname <- df_explicit_na(dataname, na_level = na_str) %>%
        dplyr::filter(treatment_flag_var == treatment_flag, worst_flag_var == worst_flag) %>%
        dplyr::mutate(postbaseline_label = "Post-Baseline"),
      env = list(
        dataname = as.name(dataname),
        na_str = na_level,
        treatment_flag_var = as.name(treatment_flag_var),
        treatment_flag = treatment_flag,
        worst_flag_var = as.name(worst_flag_var),
        worst_flag = worst_flag
      )
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = attr(dataname$baseline_var, "label") <- "Baseline Assessment",
      env = list(dataname = as.name(dataname), baseline_var = baseline_var)
    )
  )

  y$data <- bracket_expr(data_list)

  basic_table_args$title <- "Shift by Arm by Worst Table"

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args
    )
  )

  # Start layout steps.
  layout_list <- list()


  if (add_total) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = expr_basic_table_args %>%
          rtables::split_cols_by("postbaseline_label", split_fun = drop_split_levels) %>%
          rtables::split_cols_by(aval_var) %>%
          rtables::split_rows_by(
            arm_var,
            split_fun = add_overall_level(total_label, first = FALSE),
            label_pos = "topleft",
            split_label = obj_label(dataname$arm_var)
          ) %>%
          add_rowcounts() %>%
          analyze_vars(
            baseline_var,
            denom = "N_row",
            na_str = na_str,
            na.rm = na.rm,
            .stats = "count_fraction"
          ) %>%
          append_varlabels(dataname, baseline_var, indent = 1L),
        env = list(
          aval_var = aval_var,
          arm_var = arm_var,
          baseline_var = baseline_var,
          dataname = as.name(dataname),
          na.rm = na.rm,
          na_str = na_level,
          total_label = total_label,
          expr_basic_table_args = parsed_basic_table_args
        )
      )
    )
  } else {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = expr_basic_table_args %>%
          rtables::split_cols_by("postbaseline_label", split_fun = drop_split_levels) %>%
          rtables::split_cols_by(aval_var) %>%
          rtables::split_rows_by(
            arm_var,
            split_fun = drop_split_levels,
            label_pos = "topleft",
            split_label = obj_label(dataname$arm_var)
          ) %>%
          add_rowcounts() %>%
          analyze_vars(
            baseline_var,
            denom = "N_row",
            na_str = na_str,
            na.rm = na.rm,
            .stats = "count_fraction"
          ) %>%
          append_varlabels(dataname, baseline_var, indent = 1L),
        env = list(
          aval_var = aval_var,
          arm_var = arm_var,
          baseline_var = baseline_var,
          dataname = as.name(dataname),
          na.rm = na.rm,
          na_str = na_level,
          expr_basic_table_args = parsed_basic_table_args
        )
      )
    )
  }

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  # Full table.
  y$table <- substitute(
    expr = {
      result <- rtables::build_table(lyt = lyt, df = dataname)
      result
    },
    env = list(dataname = as.name(dataname))
  )

  y
}

#' teal Module: Shift by Arm by Worst Analysis Indicator Level
#'
#' This module produces a summary table of worst analysis indicator variable level per subject by arm.
#'
#' @inheritParams module_arguments
#' @inheritParams template_shift_by_arm_by_worst
#'
#' @inherit module_arguments return
#'
#' @examples
#' ADSL <- tmc_ex_adsl
#' ADEG <- tmc_ex_adeg
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADEG = ADEG,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADEG <- tmc_ex_adeg
#'     "
#'   ),
#'   modules = modules(
#'     tm_t_shift_by_arm_by_worst(
#'       label = "Shift by Arm Table",
#'       dataname = "ADEG",
#'       arm_var = choices_selected(
#'         variable_choices(ADSL, subset = c("ARM", "ARMCD")),
#'         selected = "ARM"
#'       ),
#'       paramcd = choices_selected(
#'         value_choices(ADEG, "PARAMCD"),
#'         selected = "ECGINTP"
#'       ),
#'       worst_flag_var = choices_selected(
#'         variable_choices(ADEG, c("WORS02FL", "WORS01FL")),
#'         selected = "WORS02FL"
#'       ),
#'       worst_flag = choices_selected(
#'         value_choices(ADEG, "WORS02FL"),
#'         selected = "Y", fixed = TRUE
#'       ),
#'       aval_var = choices_selected(
#'         variable_choices(ADEG, c("AVALC", "ANRIND")),
#'         selected = "AVALC"
#'       ),
#'       baseline_var = choices_selected(
#'         variable_choices(ADEG, c("BASEC", "BNRIND")),
#'         selected = "BASEC"
#'       ),
#'       useNA = "ifany"
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_shift_by_arm_by_worst <- function(label,
                                       dataname,
                                       parentname = ifelse(
                                         inherits(arm_var, "data_extract_spec"),
                                         teal.transform::datanames_input(arm_var),
                                         "ADSL"
                                       ),
                                       arm_var,
                                       paramcd,
                                       aval_var,
                                       base_var = lifecycle::deprecated(),
                                       baseline_var,
                                       worst_flag_var,
                                       worst_flag,
                                       treatment_flag_var = teal.transform::choices_selected(
                                         choices = teal.transform::variable_choices(dataname, subset = "ONTRTFL"),
                                         selected = "ONTRTFL"
                                       ),
                                       treatment_flag = teal.transform::choices_selected("Y"),
                                       useNA = c("ifany", "no"), # nolint: object_name.
                                       na_level = default_na_str(),
                                       add_total = FALSE,
                                       total_label = default_total_label(),
                                       pre_output = NULL,
                                       post_output = NULL,
                                       basic_table_args = teal.widgets::basic_table_args()) {
  if (lifecycle::is_present(base_var)) {
    baseline_var <- base_var
    warning(
      "The `base_var` argument of `tm_t_shift_by_arm_by_worst()` is deprecated as of teal.modules.clinical 0.8.16. ",
      "Please use the `baseline_var` argument instead.",
      call. = FALSE
    )
  } else {
    base_var <- baseline_var # resolves missing argument error
  }

  message("Initializing tm_t_shift_by_arm_by_worst")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  useNA <- match.arg(useNA) # nolint: object_name.
  checkmate::assert_string(na_level)
  checkmate::assert_string(total_label)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(aval_var, "choices_selected")
  checkmate::assert_class(baseline_var, "choices_selected")
  checkmate::assert_class(worst_flag_var, "choices_selected")
  checkmate::assert_class(treatment_flag_var, "choices_selected")
  checkmate::assert_class(treatment_flag, "choices_selected")
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")
  args <- as.list(environment())


  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname),
    treatment_flag_var = cs_to_des_select(treatment_flag_var, dataname = dataname),
    worst_flag_var = cs_to_des_select(worst_flag_var, dataname = dataname),
    aval_var = cs_to_des_select(aval_var, dataname = dataname),
    baseline_var = cs_to_des_select(baseline_var, dataname = dataname)
  )


  module(
    label = label,
    server = srv_shift_by_arm_by_worst,
    ui = ui_shift_by_arm_by_worst,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        treatment_flag = treatment_flag,
        total_label = total_label,
        na_level = na_level,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_shift_by_arm_by_worst <- function(id, ...) {
  ns <- NS(id)
  a <- list(...)

  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$id_var,
    a$arm_var,
    a$paramcd,
    a$worst_flag_var,
    a$treatment_flag_var,
    a$treatment_flag,
    a$aval_var,
    a$baseline_var
  )
  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c(
        "arm_var", "paramcd_var", "paramcd", "aval_var",
        "baseline_var", "worst_flag_var", "worst_flag", "treamtment_flag_var"
      )]),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select Endpoint",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("worst_flag_var"),
        label = "Select The worst flag",
        data_extract_spec = a$worst_flag_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.widgets::optionalSelectInput(
        ns("worst_flag"),
        "Value of worst flag",
        a$worst_flag$choices,
        a$worst_flag$selected,
        multiple = FALSE,
        fixed = a$worst_flag$fixed
      ),
      teal.transform::data_extract_ui(
        id = ns("aval_var"),
        label = "Select Analysis Value",
        data_extract_spec = a$aval_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("baseline_var"),
        label = "Select Baseline Value",
        data_extract_spec = a$baseline_var,
        is_single_dataset = is_single_dataset_value
      ),
      checkboxInput(ns("add_total"), "Add All Patients row", value = a$add_total),
      radioButtons(
        ns("useNA"),
        label = "Display NA counts",
        choices = c("ifany", "no"),
        selected = a$useNA
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional Variables Info",
          teal.transform::data_extract_ui(
            id = ns("treatment_flag_var"),
            label = "On Treatment Flag Variable",
            data_extract_spec = a$treatment_flag_var,
            is_single_dataset = is_single_dataset_value
          ),
          teal.widgets::optionalSelectInput(
            inputId = ns("treatment_flag"),
            label = "Value Indicating On Treatment",
            multiple = FALSE,
            fixed_on_single = TRUE
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_shift_by_arm_by_worst <- function(id,
                                      data,
                                      reporter,
                                      filter_panel_api,
                                      dataname,
                                      parentname,
                                      arm_var,
                                      paramcd,
                                      treatment_flag_var,
                                      treatment_flag,
                                      worst_flag_var,
                                      aval_var,
                                      baseline_var,
                                      label,
                                      na_level,
                                      add_total,
                                      total_label,
                                      basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")
  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        arm_var = arm_var,
        treatment_flag_var = treatment_flag_var,
        worst_flag_var = worst_flag_var,
        aval_var = aval_var,
        baseline_var = baseline_var,
        paramcd = paramcd
      ),
      datasets = data,
      select_validation_rule = list(
        arm_var = shinyvalidate::sv_required("A treatment variable is required"),
        treatment_flag_var = shinyvalidate::sv_required("A treatment flag variable is required"),
        worst_flag_var = shinyvalidate::sv_required("A worst flag variable is required"),
        aval_var = shinyvalidate::sv_required("An analysis range indicator required"),
        baseline_var = shinyvalidate::sv_required("A baseline reference range indicator is required")
      ),
      filter_validation_rule = list(
        paramcd = shinyvalidate::sv_required("An endpoint is required")
      )
    )

    isolate({
      resolved <- teal.transform::resolve_delayed(treatment_flag, as.list(data()@env))
      teal.widgets::updateOptionalSelectInput(
        session = session,
        inputId = "treatment_flag",
        choices = resolved$choices,
        selected = resolved$selected
      )
    })

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule(
        "treatment_flag",
        shinyvalidate::sv_required("An indicator value for on treatment records is required")
      )
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    # validate inputs
    validate_checks <- reactive({
      teal::validate_inputs(iv_r())

      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]

      input_arm_var <- names(merged$anl_input_r()$columns_source$arm_var)
      input_aval_var <- names(merged$anl_input_r()$columns_source$aval_var)
      input_baseline_var <- names(merged$anl_input_r()$columns_source$baseline_var)

      validate(
        need(
          nrow(merged$anl_q()[["ANL"]]) > 0,
          paste0(
            "Please make sure the analysis dataset is not empty or\n",
            "endpoint parameter and analysis visit are selected."
          )
        ),
        need(
          length(unique(merged$anl_q()[["ANL"]][[input_aval_var]])) < 50,
          paste(
            "There are too many values of", input_aval_var, "for the selected endpoint.",
            "Please select either a different endpoint or a different analysis value."
          )
        ),
        need(
          length(unique(merged$anl_q()[["ANL"]][[input_baseline_var]])) < 50,
          paste(
            "There are too many values of", input_baseline_var, "for the selected endpoint.",
            "Please select either a different endpoint or a different baseline value."
          )
        )
      )

      validate_standard_inputs(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_aval_var, input_baseline_var),
        arm_var = input_arm_var
      )
    })

    # generate r code for the analysis
    all_q <- reactive({
      validate_checks()

      my_calls <- template_shift_by_arm_by_worst(
        dataname = "ANL",
        parentname = "ANL_ADSL",
        arm_var = names(merged$anl_input_r()$columns_source$arm_var),
        paramcd = unlist(paramcd$filter)["vars_selected"],
        worst_flag_var = names(merged$anl_input_r()$columns_source$worst_flag_var),
        worst_flag = input$worst_flag,
        treatment_flag_var = names(merged$anl_input_r()$columns_source$treatment_flag_var),
        treatment_flag = input$treatment_flag,
        aval_var = names(merged$anl_input_r()$columns_source$aval_var),
        baseline_var = names(merged$anl_input_r()$columns_source$baseline_var),
        na.rm = ifelse(input$useNA == "ifany", FALSE, TRUE),
        na_level = na_level,
        add_total = input$add_total,
        total_label = total_label,
        basic_table_args = basic_table_args
      )

      teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
    })

    # Outputs to render.
    table_r <- reactive(all_q()[["result"]])

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    # Render R code.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Shift by Arm by Worst Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Adverse Events Table by Standardized MedDRA Query
#'
#' Creates a valid expression to generate an adverse events table by Standardized MedDRA Query.
#'
#' @inheritParams template_arguments
#' @param smq_varlabel (`character`)\cr label to use for new column `SMQ` created by [tern::h_stack_by_baskets()].
#' @param baskets (`character`)\cr names of the selected standardized/customized queries variables.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_smq()]
#'
#' @keywords internal
template_smq <- function(dataname,
                         parentname,
                         arm_var,
                         llt = "AEDECOD",
                         add_total = TRUE,
                         total_label = default_total_label(),
                         sort_criteria = c("freq_desc", "alpha"),
                         drop_arm_levels = TRUE,
                         na_level = default_na_str(),
                         smq_varlabel = "Standardized MedDRA Query",
                         baskets = c("SMQ01NAM", "SMQ02NAM", "CQ01NAM"),
                         id_var = "USUBJID",
                         basic_table_args = teal.widgets::basic_table_args()) {
  checkmate::assert_string(parentname)
  checkmate::assert_string(dataname)
  checkmate::assert_character(arm_var, min.len = 1, max.len = 2)
  checkmate::assert_string(id_var)
  checkmate::assert_string(llt)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_string(na_level)
  checkmate::assert_string(smq_varlabel)
  checkmate::assert_character(baskets)

  sort_criteria <- match.arg(sort_criteria)

  y <- list()

  data_list <- list()

  data_list <- add_expr(
    data_list,
    substitute(
      anl <- dataname,
      env = list(
        dataname = as.name(dataname)
      )
    )
  )

  data_list <- add_expr(
    data_list,
    prepare_arm_levels(
      dataname = "anl",
      parentname = parentname,
      arm_var = arm_var[[1]],
      drop_arm_levels = drop_arm_levels
    )
  )

  if (length(arm_var) == 2) {
    data_list <- add_expr(
      data_list,
      prepare_arm_levels(
        dataname = "anl",
        parentname = parentname,
        arm_var = arm_var[[2]],
        drop_arm_levels = drop_arm_levels
      )
    )
  }

  data_list <- add_expr(
    data_list,
    substitute(
      anl <- h_stack_by_baskets(
        df = dataname,
        baskets = baskets,
        smq_varlabel = smq_varlabel,
        keys = unique(c("STUDYID", id_var, arm_var, llt))
      ),
      env = list(
        dataname = as.name("anl"),
        baskets = baskets,
        smq_varlabel = smq_varlabel,
        id_var = id_var,
        arm_var = arm_var,
        llt = llt
      )
    )
  )

  data_list <- add_expr(
    data_list,
    quote(
      if (nrow(anl) == 0) {
        stop("Analysis dataset contains only missing values")
      }
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      anl <- df_explicit_na(
        dataname,
        na_level = na_str
      ),
      env = list(
        dataname = as.name("anl"),
        na_str = na_level
      )
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      parentname <- df_explicit_na(
        parentname,
        na_level = na_str
      ),
      env = list(
        parentname = as.name(parentname),
        na_str = na_level
      )
    )
  )

  y$data <- bracket_expr(data_list)

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(show_colcounts = TRUE)
    )
  )

  # Start layout steps.
  layout_list <- list()
  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = expr_basic_table_args %>%
        rtables::split_cols_by(var = arm_var),
      env = list(arm_var = arm_var[[1]], expr_basic_table_args = parsed_basic_table_args)
    )
  )

  if (length(arm_var) == 2) {
    layout_list <- add_expr(
      layout_list,
      if (drop_arm_levels) {
        substitute(
          expr = rtables::split_cols_by(var = nested_col, split_fun = drop_split_levels),
          env = list(nested_col = arm_var[[2]])
        )
      } else {
        substitute(
          expr = rtables::split_cols_by(var = nested_col),
          env = list(nested_col = arm_var[[2]])
        )
      }
    )
  }

  if (add_total) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = rtables::add_overall_col(total_label),
        env = list(total_label = total_label)
      )
    )
  }

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = summarize_num_patients(
        var = id_var,
        .stats = c("unique"),
        .labels = c(
          unique = "Total number of patients with at least one adverse event"
        )
      ),
      env = list(
        id_var = id_var
      )
    )
  )

  split_label <- substitute(
    expr = teal.data::col_labels(dataname, fill = FALSE)[["SMQ"]],
    env = list(
      dataname = as.name("anl")
    )
  )

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = rtables::split_rows_by(
        "SMQ",
        child_labels = "visible",
        nested = FALSE,
        split_fun = trim_levels_in_group(llt, drop_outlevs = FALSE),
        indent_mod = -1L,
        label_pos = "topleft",
        split_label = split_label
      ),
      env = list(
        llt = llt,
        split_label = split_label
      )
    )
  )

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = summarize_num_patients(
        var = id_var,
        .stats = c("unique", "nonunique"),
        .labels = c(
          unique = "Total number of patients with at least one adverse event",
          nonunique = "Total number of events"
        )
      ),
      env = list(
        id_var = id_var
      )
    )
  )

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = count_occurrences(vars = llt, drop = FALSE),
      env = list(
        llt = llt
      )
    )
  )

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = append_varlabels(dataname, llt, indent = 1L),
      env = list(
        dataname = as.name("anl"),
        llt = llt
      )
    )
  )

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  y$table <- substitute(
    expr = {
      result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
    },
    env = list(parent = as.name(parentname))
  )

  if (sort_criteria == "freq_desc") {
    y$sort <- substitute(
      expr = {
        sorted_result <- result %>%
          sort_at_path(path = c("SMQ"), scorefun = cont_n_allcols) %>%
          sort_at_path(path = c("SMQ", "*", llt), scorefun = score_occurrences, na.pos = "last")
      },
      env = list(llt = llt)
    )
  } else {
    y$sort <- quote(
      sorted_result <- result
    )
  }

  y$sort_and_prune <- quote(
    expr = {
      all_zero <- function(tr) {
        !inherits(tr, "ContentRow") && rtables::all_zero_or_na(tr)
      }
      pruned_and_sorted_result <- sorted_result %>% rtables::trim_rows(criteria = all_zero)
      pruned_and_sorted_result
    }
  )

  y
}

#' teal Module: Adverse Events Table by Standardized MedDRA Query
#'
#' This module produces an adverse events table by Standardized MedDRA Query.
#'
#' @inheritParams module_arguments
#' @inheritParams template_smq
#' @param arm_var ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for variable names that can be used as `arm_var`.
#'   It defines the grouping variable(s) in the results table.
#'   If there are two elements selected for `arm_var`,
#'   second variable will be nested under the first variable.
#' @param baskets ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected options for standardized/customized queries.
#' @param scopes ([teal.transform::choices_selected()])\cr object with all
#'   available choices for the scopes of standardized queries.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' data <- teal_data()
#' data <- within(data, {
#'   ADSL <- tmc_ex_adsl
#'   ADAE <- tmc_ex_adae
#'
#'   names_baskets <- grep("^(SMQ|CQ).*NAM$", names(ADAE), value = TRUE)
#'   names_scopes <- grep("^SMQ.*SC$", names(ADAE), value = TRUE)
#'
#'   cs_baskets <- choices_selected(
#'     choices = variable_choices(ADAE, subset = names_baskets),
#'     selected = names_baskets
#'   )
#'
#'   cs_scopes <- choices_selected(
#'     choices = variable_choices(ADAE, subset = names_scopes),
#'     selected = names_scopes,
#'     fixed = TRUE
#'   )
#' })
#'
#' datanames <- c("ADSL", "ADAE")
#' datanames(data) <- datanames
#' join_keys(data) <- default_cdisc_join_keys[datanames]
#'
#' app <- init(
#'   data = data,
#'   modules = modules(
#'     tm_t_smq(
#'       label = "Adverse Events by SMQ Table",
#'       dataname = "ADAE",
#'       arm_var = choices_selected(
#'         choices = variable_choices(data[["ADSL"]], subset = c("ARM", "SEX")),
#'         selected = "ARM"
#'       ),
#'       add_total = FALSE,
#'       baskets = data[["cs_baskets"]],
#'       scopes = data[["cs_scopes"]],
#'       llt = choices_selected(
#'         choices = variable_choices(data[["ADAE"]], subset = c("AEDECOD")),
#'         selected = "AEDECOD"
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_smq <- function(label,
                     dataname,
                     parentname = ifelse(
                       inherits(arm_var, "data_extract_spec"),
                       teal.transform::datanames_input(arm_var),
                       "ADSL"
                     ),
                     arm_var,
                     id_var = teal.transform::choices_selected(
                       teal.transform::variable_choices(dataname, subset = "USUBJID"),
                       selected = "USUBJID", fixed = TRUE
                     ),
                     llt,
                     add_total = TRUE,
                     total_label = default_total_label(),
                     sort_criteria = c("freq_desc", "alpha"),
                     drop_arm_levels = TRUE,
                     na_level = default_na_str(),
                     smq_varlabel = "Standardized MedDRA Query",
                     baskets,
                     scopes,
                     pre_output = NULL,
                     post_output = NULL,
                     basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_smq")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(id_var, "choices_selected")
  checkmate::assert_class(llt, "choices_selected")
  checkmate::assert_class(baskets, "choices_selected")
  checkmate::assert_class(scopes, "choices_selected")
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_flag(drop_arm_levels)
  sort_criteria <- match.arg(sort_criteria)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  args <- as.list(environment())

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname, multiple = TRUE, ordered = TRUE),
    id_var = cs_to_des_select(id_var, dataname = dataname),
    baskets = cs_to_des_select(baskets, dataname = dataname, multiple = TRUE),
    scopes = cs_to_des_select(scopes, dataname = dataname, multiple = TRUE),
    llt = cs_to_des_select(llt, dataname = dataname)
  )

  module(
    label = label,
    ui = ui_t_smq,
    server = srv_t_smq,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        na_level = na_level,
        label = label,
        total_label = total_label,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_t_smq <- function(id, ...) {
  ns <- NS(id)
  a <- list(...) # module args


  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$arm_var,
    a$id_var,
    a$baskets,
    a$scopes,
    a$llt
  )

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c(
        "arm_var", "baskets", "llt", "id_var", "scopes"
      )]),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("llt"),
        label = "Select the low level term",
        data_extract_spec = a$llt,
        is_single_dataset = is_single_dataset_value
      ),
      checkboxInput(ns("add_total"), "Add All Patients column", value = a$add_total),
      teal.transform::data_extract_ui(
        id = ns("baskets"),
        label = "Select the SMQXXNAM/CQXXNAM baskets",
        data_extract_spec = a$baskets,
        is_single_dataset = is_single_dataset_value
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional Variables Info",
          checkboxInput(
            ns(
              "drop_arm_levels"
            ),
            "Drop arm levels not in filtered analysis dataset",
            value = a$drop_arm_levels
          ),
          teal.transform::data_extract_ui(
            id = ns("id_var"),
            label = "Subject Identifier",
            data_extract_spec = a$id_var,
            is_single_dataset = is_single_dataset_value
          ),
          teal.transform::data_extract_ui(
            id = ns("scopes"),
            label = "Scope variables available",
            data_extract_spec = a$scopes,
            is_single_dataset = is_single_dataset_value
          ),
          selectInput(
            inputId = ns("sort_criteria"),
            label = "Sort Criteria",
            choices = c(
              "Decreasing frequency" = "freq_desc",
              "Alphabetically" = "alpha"
            ),
            selected = a$sort_criteria,
            multiple = FALSE
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_t_smq <- function(id,
                      data,
                      reporter,
                      filter_panel_api,
                      dataname,
                      parentname,
                      arm_var,
                      llt,
                      id_var,
                      baskets,
                      scopes,
                      na_level,
                      label,
                      total_label,
                      basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")
  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        scopes = scopes,
        llt = llt,
        arm_var = arm_var,
        id_var = id_var,
        baskets = baskets
      ),
      datasets = data,
      select_validation_rule = list(
        scopes = shinyvalidate::sv_required("A scope variable is required"),
        llt = shinyvalidate::sv_required("A low level term variable is required"),
        arm_var = shinyvalidate::compose_rules(
          shinyvalidate::sv_required("At least one treatment variable is required"),
          ~ if (length(.) > 2) "Please select no more than two treatment variables"
        ),
        id_var = shinyvalidate::sv_required("An id variable is required"),
        baskets = shinyvalidate::sv_required("At least one basket is required")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    validate_checks <- reactive({
      teal::validate_inputs(iv_r())
      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]

      input_arm_var <- names(merged$anl_input_r()$columns_source$arm_var)
      input_id_var <- names(merged$anl_input_r()$columns_source$id_var)
      input_baskets <- names(merged$anl_input_r()$columns_source$baskets)
      input_scopes <- names(merged$anl_input_r()$columns_source$scopes)
      input_llt <- names(merged$anl_input_r()$columns_source$llt)

      # validate inputs
      validate_standard_inputs(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var),
        anl = anl_filtered,
        anlvars = c(
          "USUBJID", "STUDYID", input_id_var, input_baskets,
          input_scopes, input_llt
        ),
        arm_var = input_arm_var[[1]]
      )
    })

    all_q <- reactive({
      validate_checks()

      my_calls <- template_smq(
        parentname = "ANL_ADSL",
        dataname = "ANL",
        arm_var = names(merged$anl_input_r()$columns_source$arm_var),
        llt = names(merged$anl_input_r()$columns_source$llt),
        add_total = input$add_total,
        total_label = total_label,
        sort_criteria = input$sort_criteria,
        drop_arm_levels = input$drop_arm_levels,
        baskets = names(merged$anl_input_r()$columns_source$baskets),
        na_level = na_level,
        id_var = names(merged$anl_input_r()$columns_source$id_var),
        basic_table_args = basic_table_args
      )

      teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
    })

    # Outputs to render.
    table_r <- reactive(all_q()[["pruned_and_sorted_result"]])

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    # Render R code.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Adverse Events Table by Standardized `MedDRA` Query (SMQ)",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Individual Patient Plots
#'
#' Creates a valid expression to generate [ggplot2::ggplot()] plots of individual patients.
#'
#' @inheritParams template_arguments
#' @param visit_var (`character`)\cr name of the variable for visit timepoints.
#' @param add_baseline_hline (`logical`)\cr whether a horizontal line should be added to the plot at baseline y-value.
#' @param separate_by_obs (`logical`)\cr whether to create multi-panel plots.
#' @param suppress_legend (`logical`)\cr whether to suppress the plot legend.
#' @param arm_levels (`character`)\cr vector of all levels of `arm_var`.
#' @param avalu_first (`character`)\cr `avalu_var` text to append to the plot title and y-axis label if `add_avalu` is
#'   `TRUE`.
#' @param paramcd_first (`character`)\cr `paramcd` text to append to the plot title and y-axis label.
#' @param add_avalu (`logical`)\cr whether `avalu_first` text should be appended to the plot title and y-axis label.
#' @param ggplot2_args (`ggplot2_args`) optional\cr object created by [teal.widgets::ggplot2_args()] with settings
#'   for the module plot. For this module, this argument will only accept `ggplot2_args` object with `labs` list of
#'   the following child elements: `title`, `subtitle`, `x`, `y`. No other elements are taken into account. The
#'   argument is merged with option `teal.ggplot2_args` and with default module arguments (hard coded in the module
#'   body).
#'
#'   For more details, see the vignette: `vignette("custom-ggplot2-arguments", package = "teal.widgets")`.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_g_ipp()]
#'
#' @keywords internal
template_g_ipp <- function(dataname = "ANL",
                           paramcd,
                           arm_var,
                           arm_levels,
                           avalu_first,
                           paramcd_first,
                           aval_var = "AVAL",
                           avalu_var = "AVALU",
                           id_var = "USUBJID",
                           visit_var = "AVISIT",
                           base_var = lifecycle::deprecated(),
                           baseline_var = "BASE",
                           add_baseline_hline = FALSE,
                           separate_by_obs = FALSE,
                           ggplot2_args = teal.widgets::ggplot2_args(),
                           suppress_legend = FALSE,
                           add_avalu = TRUE) {
  if (lifecycle::is_present(base_var)) {
    baseline_var <- base_var
    warning(
      "The `base_var` argument of `template_g_ipp()` is deprecated as of teal.modules.clinical 0.8.16. ",
      "Please use the `baseline_var` argument instead.",
      call. = FALSE
    )
  }

  checkmate::assert_string(dataname)
  checkmate::assert_string(paramcd)
  checkmate::assert_string(arm_var)
  checkmate::assert_string(aval_var)
  checkmate::assert_string(avalu_var)
  checkmate::assert_string(id_var)
  checkmate::assert_string(visit_var)
  checkmate::assert_string(baseline_var)
  checkmate::assert_flag(add_baseline_hline)
  checkmate::assert_flag(separate_by_obs)
  checkmate::assert_flag(suppress_legend)
  checkmate::assert_flag(add_avalu)

  y <- list()
  # Data preprocessing

  y$data <- substitute(
    expr = anl <- df %>% droplevels(),
    env = list(df = as.name(dataname))
  )

  title <- ifelse(
    add_avalu,
    sprintf("Individual Patient Plot for %s Values (%s) over Time", paramcd_first, avalu_first),
    sprintf("Individual Patient Plot for %s Values over Time", paramcd_first)
  )
  y_axis <- ifelse(
    add_avalu,
    sprintf("%s (%s)", paramcd_first, avalu_first),
    paramcd_first
  )

  all_ggplot2_args <- teal.widgets::resolve_ggplot2_args(
    user_plot = ggplot2_args,
    module_plot = teal.widgets::ggplot2_args(
      labs = list(
        title = title,
        x = "Visit",
        y = y_axis,
        subtitle = paste(arm_levels, collapse = ", ")
      )
    )
  )

  graph_list <- list()
  graph_list <- add_expr(
    graph_list,
    substitute(
      expr = {
        plot <- h_g_ipp(
          df = anl,
          xvar = visit,
          yvar = aval,
          xlab = xlab_val,
          ylab = ylab_val,
          title = title_val,
          subtitle = subtitle_val,
          id_var = id,
          add_baseline_hline = add_baseline_hline,
          yvar_baseline = base
        )
      },
      env = list(
        xlab_val = all_ggplot2_args$labs$x,
        ylab_val = all_ggplot2_args$labs$y,
        title_val = all_ggplot2_args$labs$title,
        subtitle_val = all_ggplot2_args$labs$subtitle,
        paramcd = paramcd,
        visit = visit_var,
        aval = aval_var,
        id = id_var,
        add_baseline_hline = add_baseline_hline,
        base = baseline_var,
        avalu = avalu_var,
        arm = arm_var
      )
    )
  )

  if (separate_by_obs) {
    graph_list <- add_expr(
      graph_list,
      substitute(
        expr = plot <- plot + ggplot2::facet_grid(rows = ggplot2::vars(id)),
        env = list(id = as.name(id_var))
      )
    )
  }

  if (suppress_legend) {
    graph_list <- add_expr(
      graph_list,
      substitute(
        expr = {
          plot <- plot + ggplot2::theme(legend.position = "none")
        },
        env = list(id = as.name(id_var))
      )
    )
  }

  graph_list <- add_expr(
    graph_list,
    quote(grid::grid.newpage())
  )

  graph_list <- add_expr(
    graph_list,
    quote(grid::grid.draw(plot))
  )

  y$graph <- bracket_expr(graph_list)

  y
}

#' teal Module: Individual Patient Plots
#'
#' This module produces [ggplot2::ggplot()] type individual patient plots that display trends in parameter
#' values over time for each patient, using data with ADaM structure.
#'
#' @inheritParams module_arguments
#' @inheritParams template_g_ipp
#' @param arm_var ([teal.transform::choices_selected()])\cr object with
#'   all available choices and preselected option for variable values that can be used as arm variable.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' library(nestcolor)
#' library(dplyr)
#'
#' ADSL <- tmc_ex_adsl %>%
#'   slice(1:20) %>%
#'   df_explicit_na()
#' ADLB <- tmc_ex_adlb %>%
#'   filter(USUBJID %in% ADSL$USUBJID) %>%
#'   df_explicit_na() %>%
#'   filter(AVISIT != "SCREENING")
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADLB = ADLB,
#'     code = "
#'       ADSL <- tmc_ex_adsl %>% slice(1:20) %>% df_explicit_na()
#'       ADLB <- tmc_ex_adlb %>% filter(USUBJID %in% ADSL$USUBJID) %>%
#'         df_explicit_na() %>% filter(AVISIT != \"SCREENING\")
#'     "
#'   ),
#'   modules = modules(
#'     tm_g_ipp(
#'       label = "Individual Patient Plot",
#'       dataname = "ADLB",
#'       arm_var = choices_selected(
#'         value_choices(ADLB, "ARMCD"),
#'         "ARM A"
#'       ),
#'       paramcd = choices_selected(
#'         value_choices(ADLB, "PARAMCD"),
#'         "ALT"
#'       ),
#'       aval_var = choices_selected(
#'         variable_choices(ADLB, c("AVAL", "CHG")),
#'         "AVAL"
#'       ),
#'       avalu_var = choices_selected(
#'         variable_choices(ADLB, c("AVALU")),
#'         "AVALU",
#'         fixed = TRUE
#'       ),
#'       id_var = choices_selected(
#'         variable_choices(ADLB, c("USUBJID")),
#'         "USUBJID",
#'         fixed = TRUE
#'       ),
#'       visit_var = choices_selected(
#'         variable_choices(ADLB, c("AVISIT")),
#'         "AVISIT"
#'       ),
#'       baseline_var = choices_selected(
#'         variable_choices(ADLB, c("BASE")),
#'         "BASE",
#'         fixed = TRUE
#'       ),
#'       add_baseline_hline = FALSE,
#'       separate_by_obs = FALSE
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_g_ipp <- function(label,
                     dataname,
                     parentname = ifelse(
                       inherits(arm_var, "data_extract_spec"),
                       teal.transform::datanames_input(arm_var),
                       "ADSL"
                     ),
                     arm_var,
                     paramcd,
                     id_var = teal.transform::choices_selected(
                       teal.transform::variable_choices(dataname, "USUBJID"),
                       "USUBJID",
                       fixed = TRUE
                     ),
                     visit_var = teal.transform::choices_selected(
                       teal.transform::variable_choices(dataname, "AVISIT"),
                       "AVISIT",
                       fixed = TRUE
                     ),
                     aval_var = teal.transform::choices_selected(
                       teal.transform::variable_choices(dataname, "AVAL"),
                       "AVAL",
                       fixed = TRUE
                     ),
                     avalu_var = teal.transform::choices_selected(
                       teal.transform::variable_choices(dataname, "AVALU"),
                       "AVALU",
                       fixed = TRUE
                     ),
                     base_var = lifecycle::deprecated(),
                     baseline_var = teal.transform::choices_selected(
                       teal.transform::variable_choices(dataname, "BASE"),
                       "BASE",
                       fixed = TRUE
                     ),
                     add_baseline_hline = FALSE,
                     separate_by_obs = FALSE,
                     suppress_legend = FALSE,
                     add_avalu = TRUE,
                     plot_height = c(1200L, 400L, 5000L),
                     plot_width = NULL,
                     pre_output = NULL,
                     post_output = NULL,
                     ggplot2_args = teal.widgets::ggplot2_args()) {
  if (lifecycle::is_present(base_var)) {
    baseline_var <- base_var
    warning(
      "The `base_var` argument of `tm_g_ipp()` is deprecated as of teal.modules.clinical 0.8.16. ",
      "Please use the `baseline_var` argument instead.",
      call. = FALSE
    )
  } else {
    base_var <- baseline_var # resolves missing argument error
  }

  message("Initializing tm_g_ipp")
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(id_var, "choices_selected")
  checkmate::assert_class(visit_var, "choices_selected")
  checkmate::assert_class(aval_var, "choices_selected")
  checkmate::assert_class(avalu_var, "choices_selected")
  checkmate::assert_class(baseline_var, "choices_selected")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_flag(add_baseline_hline)
  checkmate::assert_flag(separate_by_obs)
  checkmate::assert_flag(suppress_legend)
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(ggplot2_args, "ggplot2_args")

  args <- as.list(environment())
  data_extract_list <- list(
    arm_var = cs_to_des_filter(arm_var, dataname = parentname, multiple = TRUE, include_vars = TRUE),
    aval_var = cs_to_des_select(aval_var, dataname = dataname),
    avalu_var = cs_to_des_select(avalu_var, dataname = dataname),
    id_var = cs_to_des_select(id_var, dataname = dataname),
    visit_var = cs_to_des_select(visit_var, dataname = dataname),
    baseline_var = cs_to_des_select(baseline_var, dataname = dataname),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname)
  )

  module(
    label = label,
    server = srv_g_ipp,
    ui = ui_g_ipp,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        label = label,
        parentname = parentname,
        plot_height = plot_height,
        plot_width = plot_width,
        ggplot2_args = ggplot2_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_g_ipp <- function(id, ...) {
  a <- list(...) # module args
  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$arm_var,
    a$aval_var,
    a$avalu_var,
    a$id_var,
    a$visit_var,
    a$paramcd,
    a$baseline_var
  )

  ns <- NS(id)

  teal.widgets::standard_layout(
    output = teal.widgets::plot_with_settings_ui(id = ns("myplot")),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(
        a[c("arm_var", "aval_var", "avalu_var", "id_var", "visit_var", "paramcd", "baseline_var")]
      ),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Arm",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select Parameter",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("visit_var"),
        label = "Timepoint Variable",
        data_extract_spec = a$visit_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("aval_var"),
        label = "Parameter values over Time",
        data_extract_spec = a$aval_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("id_var"),
        label = "Patient ID",
        data_extract_spec = a$id_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("avalu_var"),
        label = "Analysis Variable Unit",
        data_extract_spec = a$avalu_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("baseline_var"),
        label = "Baseline Parameter Values",
        data_extract_spec = a$baseline_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional plot settings",
          checkboxInput(
            ns("add_baseline_hline"),
            "Add reference lines at baseline value",
            value = a$add_baseline_hline
          ),
          checkboxInput(
            ns("separate_by_obs"),
            "Separate plots by ID",
            value = a$separate_by_obs
          ),
          checkboxInput(
            ns("suppress_legend"),
            "Suppress legend",
            value = a$suppress_legend
          ),
          checkboxInput(
            ns("add_avalu"),
            "Add unit value in title/y axis",
            value = a$add_avalu
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_g_ipp <- function(id,
                      data,
                      reporter,
                      filter_panel_api,
                      dataname,
                      parentname,
                      arm_var,
                      paramcd,
                      aval_var,
                      avalu_var,
                      id_var,
                      visit_var,
                      baseline_var,
                      plot_height,
                      plot_width,
                      label,
                      ggplot2_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    selector_list <- teal.transform::data_extract_multiple_srv(
      datasets = data,
      data_extract = list(
        arm_var = arm_var,
        aval_var = aval_var,
        avalu_var = avalu_var,
        id_var = id_var,
        paramcd = paramcd,
        visit_var = visit_var,
        baseline_var = baseline_var
      ),
      select_validation_rule = list(
        aval_var = shinyvalidate::sv_required("A Parameter values over Time must be selected"),
        avalu_var = shinyvalidate::sv_required("An Analysis Variable Unit must be selected"),
        visit_var = shinyvalidate::sv_required("A Timepoint Variable must be selected"),
        id_var = shinyvalidate::sv_required("A Patient ID must be selected"),
        baseline_var = shinyvalidate::sv_required("Baseline Parameter Values must be selected")
      ),
      filter_validation_rule = list(
        paramcd = shinyvalidate::sv_required(message = "Please select Parameter filter."),
        arm_var = shinyvalidate::sv_required(message = "Please select Arm filter.")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      join_keys = teal.data::join_keys(data),
      data_extract = list(arm_var = arm_var, id_var = id_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    # Prepare the analysis environment (filter data, check data, populate envir).
    validate_checks <- reactive({
      teal::validate_inputs(iv_r())

      adsl_filtered <- anl_q()[[parentname]]
      anl_filtered <- anl_q()[[dataname]]

      anl_m <- anl_inputs()
      input_arm_var <- unlist(arm_var$filter)["vars_selected"]
      input_aval_var <- as.vector(anl_m$columns_source$aval_var)
      input_avalu_var <- as.vector(anl_m$columns_source$avalu_var)
      input_id_var <- as.vector(anl_m$columns_source$id_var)
      input_visit_var <- as.vector(anl_m$columns_source$visit_var)
      input_baseline_var <- as.vector(anl_m$columns_source$baseline_var)
      input_paramcd <- unlist(paramcd$filter)["vars_selected"]

      # validate inputs
      validate_args <- list(
        adsl = adsl_filtered,
        adslvars = c("STUDYID", input_id_var, input_arm_var),
        anl = anl_filtered,
        anlvars = c(
          "STUDYID",
          input_id_var,
          input_arm_var,
          input_aval_var,
          input_avalu_var,
          input_paramcd,
          input_visit_var,
          input_baseline_var
        ),
        arm_var = input_arm_var
      )

      do.call(what = "validate_standard_inputs", validate_args)
      NULL
    })

    # The R-code corresponding to the analysis.
    all_q <- reactive({
      validate_checks()
      anl_m <- anl_inputs()

      ANL <- anl_q()[["ANL"]]
      teal::validate_has_data(ANL, 2)

      arm_var <- unlist(arm_var$filter)["vars_selected"]
      avalu_var <- as.vector(anl_m$columns_source$avalu_var)
      paramcd <- unlist(paramcd$filter)["vars_selected"]

      avalu_first <- as.character(ANL[[avalu_var]][1])
      paramcd_first <- as.character(ANL[[paramcd]][1])
      arm_levels <- levels(droplevels(ANL[[arm_var]]))

      my_calls <- template_g_ipp(
        dataname = "ANL",
        aval_var = as.vector(anl_m$columns_source$aval_var),
        avalu_var = avalu_var,
        avalu_first = avalu_first,
        id_var = as.vector(anl_m$columns_source$id_var),
        visit_var = as.vector(anl_m$columns_source$visit_var),
        baseline_var = as.vector(anl_m$columns_source$baseline_var),
        add_baseline_hline = input$add_baseline_hline,
        separate_by_obs = input$separate_by_obs,
        suppress_legend = input$suppress_legend,
        paramcd = paramcd,
        paramcd_first = paramcd_first,
        arm_var = arm_var,
        arm_levels = arm_levels,
        ggplot2_args = ggplot2_args,
        add_avalu = input$add_avalu
      )
      teal.code::eval_code(anl_q(), as.expression(my_calls))
    })

    # Outputs to render.
    plot_r <- reactive(all_q()[["plot"]])

    # Insert the plot into a plot with settings module from teal.widgets
    pws <- teal.widgets::plot_with_settings_srv(
      id = "myplot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Individual Patient Plot",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Plot", "header3")
        card$append_plot(plot_r(), dim = pws$dim())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Confidence Interval Plot
#'
#' Creates a valid expression to generate a [ggplot2::ggplot()] confidence interval plot.
#'
#' @inheritParams template_arguments
#' @param x_var (`character`)\cr name of the treatment variable to put on the x-axis.
#' @param y_var (`character`)\cr name of the response variable to put on the y-axis.
#' @param grp_var (`character`)\cr name of the group variable used to determine the plot colors, point shapes,
#'   and line types.
#' @param stat (`character`)\cr statistic to plot. Options are `"mean"` and `"median"`.
#' @param unit_var (`character`)\cr name of the unit variable.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_g_ci()]
#'
#' @keywords internal
template_g_ci <- function(dataname,
                          x_var,
                          y_var,
                          grp_var = NULL,
                          stat = c("mean", "median"),
                          conf_level = 0.95,
                          unit_var = "AVALU",
                          ggplot2_args = teal.widgets::ggplot2_args()) {
  stat <- match.arg(stat)

  graph_list <- list()
  graph_list <- if (is.null(grp_var)) {
    add_expr(
      expr_ls = graph_list,
      new_expr = {
        substitute(
          expr = ggplot2::ggplot(
            data = ANL,
            mapping = ggplot2::aes(
              x = x_var,
              y = y_var
            )
          ),
          env = list(
            x_var = as.name(x_var),
            y_var = as.name(y_var)
          )
        )
      }
    )
  } else {
    add_expr(
      expr_ls = graph_list,
      new_expr = {
        substitute(
          expr = ggplot2::ggplot(
            data = ANL,
            mapping = ggplot2::aes(
              x = x_var,
              y = y_var,
              color = grp_var,
              lty = grp_var,
              shape = grp_var
            )
          ),
          env = list(
            x_var = as.name(x_var),
            y_var = as.name(y_var),
            grp_var = as.name(grp_var)
          )
        )
      }
    )
  }

  graph_list <- if (conf_level == 0.95) {
    add_expr(
      expr_ls = graph_list,
      new_expr = substitute(
        expr = ggplot2::stat_summary(
          fun.data = fun,
          geom = "errorbar",
          width = .1,
          position = ggplot2::position_dodge(width = .5)
        ),
        env = list(
          fun = switch(stat,
            mean = substitute(stat_mean_ci),
            median = substitute(stat_median_ci)
          )
        )
      )
    )
  } else {
    add_expr(
      expr_ls = graph_list,
      new_expr = substitute(
        expr = ggplot2::stat_summary(
          fun.data = fun,
          geom = "errorbar",
          width = .1,
          position = ggplot2::position_dodge(width = .5)
        ),
        env = list(
          fun = switch(stat,
            mean = substitute(
              expr = function(x) stat_mean_ci(x, conf_level = conf_level),
              env = list(conf_level = conf_level)
            ),
            median = substitute(
              expr = function(x) stat_median_ci(x, conf_level = conf_level),
              env = list(conf_level = conf_level)
            )
          )
        )
      )
    )
  }

  graph_list <- add_expr(
    expr_ls = graph_list,
    new_expr = substitute(
      expr = ggplot2::stat_summary(
        fun = fun,
        geom = "point",
        position = ggplot2::position_dodge(width = .5)
      ),
      env = list(
        fun = switch(stat,
          mean = quote(mean),
          median = quote(median)
        )
      )
    )
  )

  parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args(
    teal.widgets::resolve_ggplot2_args(
      user_plot = ggplot2_args,
      module_plot = teal.widgets::ggplot2_args(
        labs = list(
          title = "Confidence Interval Plot by Treatment Group",
          caption = sprintf(
            "%s and %i%% CIs for %s are displayed.",
            switch(stat,
              mean = "Mean",
              median = "Median"
            ),
            100 * conf_level,
            stat
          ),
          x = "Treatment Group",
          y = "Value",
          color = "",
          lty = "",
          shape = ""
        ),
        theme = list()
      )
    )
  )

  graph_list <- add_expr(
    expr_ls = graph_list,
    new_expr = parsed_ggplot2_args$labs
  )

  if (!is.null(parsed_ggplot2_args$theme)) {
    graph_list <- add_expr(
      expr_ls = graph_list,
      new_expr = parsed_ggplot2_args$theme
    )
  }

  substitute(
    expr = {
      gg <- graph_expr
      print(gg)
    },
    env = list(graph_expr = pipe_expr(graph_list, pipe_str = "+"))
  )
}

#' teal Module: Confidence Interval Plot
#'
#' This module produces a [ggplot2::ggplot()] type confidence interval plot consistent with the TLG Catalog template
#' `CIG01` available [here](https://insightsengineering.github.io/tlg-catalog/stable/graphs/other/cig01.html).
#'
#' @inheritParams module_arguments
#' @inheritParams template_g_ci
#' @param color (`data_extract_spec`)\cr the group variable used to determine the plot colors, shapes, and line types.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' library(nestcolor)
#'
#' ADSL <- tmc_ex_adsl
#' ADLB <- tmc_ex_adlb
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADLB = ADLB,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADLB <- tmc_ex_adlb
#'     "
#'   ),
#'   modules = modules(
#'     tm_g_ci(
#'       label = "Confidence Interval Plot",
#'       x_var = data_extract_spec(
#'         dataname = "ADSL",
#'         select = select_spec(
#'           choices = c("ARMCD", "BMRKR2"),
#'           selected = c("ARMCD"),
#'           multiple = FALSE,
#'           fixed = FALSE
#'         )
#'       ),
#'       y_var = data_extract_spec(
#'         dataname = "ADLB",
#'         filter = list(
#'           filter_spec(
#'             vars = "PARAMCD",
#'             choices = levels(ADLB$PARAMCD),
#'             selected = levels(ADLB$PARAMCD)[1],
#'             multiple = FALSE,
#'             label = "Select lab:"
#'           ),
#'           filter_spec(
#'             vars = "AVISIT",
#'             choices = levels(ADLB$AVISIT),
#'             selected = levels(ADLB$AVISIT)[1],
#'             multiple = FALSE,
#'             label = "Select visit:"
#'           )
#'         ),
#'         select = select_spec(
#'           label = "Analyzed Value",
#'           choices = c("AVAL", "CHG"),
#'           selected = "AVAL",
#'           multiple = FALSE,
#'           fixed = FALSE
#'         )
#'       ),
#'       color = data_extract_spec(
#'         dataname = "ADSL",
#'         select = select_spec(
#'           label = "Color by variable",
#'           choices = c("SEX", "STRATA1", "STRATA2"),
#'           selected = c("STRATA1"),
#'           multiple = FALSE,
#'           fixed = FALSE
#'         )
#'       )
#'     )
#'   ),
#'   header = "Example of Confidence Interval Plot",
#'   footer = tags$p(
#'     class = "text-muted", "Source: `teal.modules.clinical::tm_g_ci`"
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_g_ci <- function(label,
                    x_var,
                    y_var,
                    color,
                    stat = c("mean", "median"),
                    conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE),
                    plot_height = c(700L, 200L, 2000L),
                    plot_width = NULL,
                    pre_output = NULL,
                    post_output = NULL,
                    ggplot2_args = teal.widgets::ggplot2_args()) {
  message("Initializing tm_g_ci")
  checkmate::assert_string(label)
  stat <- match.arg(stat)
  checkmate::assert_class(y_var, classes = "data_extract_spec")
  checkmate::assert_class(x_var, classes = "data_extract_spec")
  checkmate::assert_class(color, classes = "data_extract_spec")
  checkmate::assert_class(conf_level, "choices_selected")
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(ggplot2_args, "ggplot2_args")

  args <- as.list(environment())

  module(
    label = label,
    server = srv_g_ci,
    server_args = list(
      x_var = x_var,
      y_var = y_var,
      color = color,
      label = label,
      plot_height = plot_height,
      plot_width = plot_width,
      ggplot2_args = ggplot2_args
    ),
    ui = ui_g_ci,
    ui_args = args,
    datanames = "all"
  )
}

#' @keywords internal
ui_g_ci <- function(id, ...) {
  ns <- NS(id)
  args <- list(...)

  teal.widgets::standard_layout(
    output = teal.widgets::plot_with_settings_ui(id = ns("myplot")),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(args[c("x_var", "y_var", "color")]),
      teal.transform::data_extract_ui(
        id = ns("x_var"),
        label = "Treatment (x axis)",
        data_extract_spec = args$x_var
      ),
      teal.transform::data_extract_ui(
        id = ns("y_var"),
        label = "Analysis Value (y axis)",
        data_extract_spec = args$y_var
      ),
      teal.transform::data_extract_ui(
        id = ns("color"),
        label = "Groups (color)",
        data_extract_spec = args$color
      ),
      teal.widgets::optionalSelectInput(
        inputId = ns("conf_level"),
        label = "Confidence Level",
        choices = args$conf_level$choices,
        selected = args$conf_level$selected,
        multiple = FALSE,
        fixed = args$conf_level$fixed
      ),
      radioButtons(
        inputId = ns("stat"),
        label = "Statistic to use",
        choices = c("mean", "median"),
        selected = args$stat
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
    ),
    pre_output = args$pre_output,
    post_output = args$post_output
  )
}

#' @keywords internal
srv_g_ci <- function(id,
                     data,
                     reporter,
                     filter_panel_api,
                     x_var,
                     y_var,
                     color,
                     label,
                     plot_height,
                     plot_width,
                     ggplot2_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(x_var = x_var, y_var = y_var, color = color),
      datasets = data,
      select_validation_rule = list(
        x_var = shinyvalidate::sv_required("Select a treatment (x axis)"),
        y_var = shinyvalidate::sv_required("Select an analysis value (y axis)")
      ),
      filter_validation_rule = list(
        y_var = shinyvalidate::sv_required(message = "Please select the filters.")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level"))
      iv$add_rule(
        "conf_level",
        shinyvalidate::sv_between(0, 1, message_fmt = "Please choose a confidence level between 0 and 1")
      )
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      join_keys = teal.data::join_keys(data),
      selector_list = selector_list
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr))
    })

    all_q <- reactive({
      teal::validate_inputs(iv_r())
      teal::validate_has_data(anl_q()[["ANL"]], min_nrow = 2)

      x <- anl_inputs()$columns_source$x_var
      y <- anl_inputs()$columns_source$y_var
      color <- anl_inputs()$columns_source$color

      validate(
        need(
          !all(is.na(anl_q()[["ANL"]][[y]])),
          "No valid data. Please check the filtering option for analysis value (y axis)"
        )
      )

      x_label <- column_annotation_label(data()[[attr(x, "dataname")]], x)
      y_label <- column_annotation_label(data()[[attr(y, "dataname")]], y)
      color_label <- if (length(color)) {
        column_annotation_label(data()[[attr(color, "dataname")]], color)
      } else {
        NULL
      }

      ggplot2_args$labs$title <- paste("Confidence Interval Plot by", x_label)
      ggplot2_args$labs$x <- x_label
      ggplot2_args$labs$subtitle <- paste("Visit:", anl_inputs()$filter_info$y_var[[2]]$selected[[1]])
      ggplot2_args$labs$y <- paste(
        anl_inputs()$filter_info$y_var[[1]]$selected[[1]],
        y_label
      )
      ggplot2_args$labs$color <- color_label
      ggplot2_args$labs$lty <- color_label
      ggplot2_args$labs$shape <- color_label
      list_calls <- template_g_ci(
        dataname = "ANL",
        x_var = x,
        y_var = y,
        grp_var = if (length(color) == 0) {
          NULL
        } else {
          color
        },
        stat = input$stat,
        conf_level = as.numeric(input$conf_level),
        ggplot2_args = ggplot2_args
      )
      teal.code::eval_code(anl_q(), list_calls)
    })

    plot_r <- reactive(all_q()[["gg"]])

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    pws <- teal.widgets::plot_with_settings_srv(
      id = "myplot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "CI Plot",
          label = label,
          description = "Confidence Interval Plot",
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Plot", "header3")
        card$append_plot(plot_r(), dim = pws$dim())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Laboratory test results with highest grade post-baseline
#'
#' Creates a valid expression to generate a table to summarize abnormality by grade.
#'
#' @inheritParams template_arguments
#' @param atoxgr_var (`character`)\cr name of the variable indicating
#' Analysis Toxicity Grade.
#' @param worst_high_flag_var (`character`)\cr name of the variable indicating
#' Worst High Grade flag
#' @param worst_low_flag_var (`character`)\cr name of the variable indicating
#' Worst Low Grade flag
#' @param worst_flag_indicator (`character`)\cr flag value indicating the worst grade.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_abnormality_by_worst_grade()]
#' @keywords internal
template_abnormality_by_worst_grade <- function(parentname, # nolint: object_length.
                                                dataname,
                                                arm_var,
                                                id_var = "USUBJID",
                                                paramcd = "PARAMCD",
                                                atoxgr_var = "ATOXGR",
                                                worst_high_flag_var = "WGRHIFL",
                                                worst_low_flag_var = "WGRLOFL",
                                                worst_flag_indicator = "Y",
                                                add_total = FALSE,
                                                total_label = default_total_label(),
                                                drop_arm_levels = TRUE,
                                                basic_table_args = teal.widgets::basic_table_args()) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(arm_var)
  checkmate::assert_string(id_var)
  checkmate::assert_string(paramcd)
  checkmate::assert_string(atoxgr_var)
  checkmate::assert_string(worst_high_flag_var)
  checkmate::assert_string(worst_low_flag_var)
  checkmate::assert_string(worst_flag_indicator)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_flag(drop_arm_levels)

  y <- list()

  data_list <- list()

  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl_labels <- teal.data::col_labels(df, fill = FALSE),
      env = list(
        df = as.name(dataname)
      )
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl <- df %>%
        dplyr::mutate(
          # Changed the following prepo step methodology as not
          # all cases have grade = 4 (realized with nsdl real data)
          GRADE_DIR = factor(
            dplyr::case_when(
              as.numeric(as.character(atoxgr_var)) < 0 ~ "LOW",
              atoxgr_var == "0" ~ "ZERO",
              as.numeric(as.character(atoxgr_var)) > 0 ~ "HIGH"
            ),
            levels = c("LOW", "ZERO", "HIGH")
          ),
          # Changed the following prepo step methodology as not
          # all cases have grade = 4 (realized with nsdl real data)
          GRADE_ANL = factor(
            abs(
              as.numeric(
                as.character(atoxgr_var)
              )
            )
          )
        ) %>%
        dplyr::filter(worst_low_flag_var == worst_flag_indicator | worst_high_flag_var == worst_flag_indicator) %>%
        droplevels(),
      env = list(
        df = as.name(dataname),
        worst_low_flag_var = as.name(worst_low_flag_var),
        worst_high_flag_var = as.name(worst_high_flag_var),
        worst_flag_indicator = worst_flag_indicator,
        atoxgr_var = as.name(atoxgr_var)
      )
    )
  )

  data_list <- add_expr(
    data_list,
    quote(
      expr = teal.data::col_labels(anl) <- c(
        anl_labels,
        GRADE_DIR = "   Direction of Abnormality",
        GRADE_ANL = "Highest Grade"
      )
    )
  )

  data_list <- add_expr(
    data_list,
    prepare_arm_levels(
      dataname = "anl",
      parentname = parentname,
      arm_var = arm_var,
      drop_arm_levels = drop_arm_levels
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = if (is.null(obj_label(anl[[paramcd]]))) {
        stop("Please specify label for ", paramcd)
      },
      env = list(
        paramcd = paramcd
      )
    )
  )

  y$data <- bracket_expr(data_list)

  # map creation

  prep_list <- list()

  prep_list <- add_expr(
    prep_list,
    substitute(
      expr = map <- expand.grid(
        PARAM = levels(anl[[paramcd]]),
        GRADE_DIR = c("LOW", "HIGH"),
        GRADE_ANL = as.character(1:4),
        stringsAsFactors = FALSE
      ) %>%
        dplyr::arrange(paramcd, desc(GRADE_DIR), GRADE_ANL),
      env = list(
        paramcd = paramcd
      )
    )
  )

  y$layout_prep <- bracket_expr(prep_list)

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(show_colcounts = TRUE)
    )
  )

  # layout start
  layout_list <- list()
  layout_list <- add_expr(
    layout_list,
    if (add_total) {
      substitute(
        expr = expr_basic_table_args %>%
          rtables::split_cols_by(
            var = arm_var,
            split_fun = add_overall_level(label = total_label, first = FALSE)
          ),
        env = list(
          arm_var = arm_var,
          total_label = total_label,
          expr_basic_table_args = parsed_basic_table_args
        )
      )
    } else {
      substitute(
        expr = expr_basic_table_args %>%
          rtables::split_cols_by(var = arm_var),
        env = list(arm_var = arm_var, expr_basic_table_args = parsed_basic_table_args)
      )
    }
  )

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = rtables::split_rows_by(
        paramcd,
        label_pos = "topleft",
        split_label = obj_label(anl[[paramcd]])
      ) %>%
        summarize_num_patients(
          var = id_var,
          required = "GRADE_ANL",
          .stats = "unique_count"
        ) %>%
        rtables::split_rows_by(
          "GRADE_DIR",
          label_pos = "topleft",
          split_fun = trim_levels_to_map(map = map),
          split_label = obj_label(anl$GRADE_DIR)
        ) %>%
        count_abnormal_by_worst_grade(
          var = "GRADE_ANL",
          variables = list(id = id_var, param = paramcd, grade_dir = "GRADE_DIR"),
          .indent_mods = 4L
        ) %>%
        rtables::append_topleft("                                  Highest Grade"),
      env = list(
        paramcd = paramcd,
        id_var = id_var
      )
    )
  )

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  y$table <- substitute(
    expr = {
      result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
      result
    },
    env = list(parent = as.name(parentname))
  )

  y
}

#' teal Module: Laboratory test results with highest grade post-baseline
#'
#' This module produces a table to summarize laboratory test results with highest grade post-baseline

#' @inheritParams module_arguments
#' @inheritParams template_abnormality_by_worst_grade
#' @param atoxgr_var ([teal.transform::choices_selected()])\cr
#' object with all available choices and preselected option
#' for variable names that can be used as Analysis Toxicity Grade.
#' @param worst_high_flag_var ([teal.transform::choices_selected()])\cr
#' object with all available choices and preselected option for variable names that can be used as Worst High
#' Grade flag.
#' @param worst_low_flag_var ([teal.transform::choices_selected()])\cr
#' object with all available choices and preselected option for variable names that can be used as Worst Low Grade flag.
#' @param worst_flag_indicator ([teal.transform::choices_selected()])\cr
#' value indicating worst grade.
#'
#' @inherit module_arguments return seealso
#'
#' @export
#'
#' @examples
#' library(dplyr)
#'
#' ADSL <- tmc_ex_adsl
#' ADLB <- tmc_ex_adlb %>%
#'   filter(!AVISIT %in% c("SCREENING", "BASELINE"))
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADLB = ADLB,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADLB <- tmc_ex_adlb %>%
#'         filter(!AVISIT %in% c(\"SCREENING\", \"BASELINE\"))
#'     "
#'   ),
#'   modules = modules(
#'     tm_t_abnormality_by_worst_grade(
#'       label = "Laboratory Test Results with Highest Grade Post-Baseline",
#'       dataname = "ADLB",
#'       arm_var = choices_selected(
#'         choices = variable_choices(ADSL, subset = c("ARM", "ARMCD")),
#'         selected = "ARM"
#'       ),
#'       paramcd = choices_selected(
#'         choices = value_choices(ADLB, "PARAMCD", "PARAM"),
#'         selected = c("ALT", "CRP", "IGA")
#'       ),
#'       add_total = FALSE
#'     )
#'   ),
#'   filter = teal_slices(
#'     teal_slice("ADSL", "SAFFL", selected = "Y"),
#'     teal_slice("ADLB", "ONTRTFL", selected = "Y")
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
tm_t_abnormality_by_worst_grade <- function(label, # nolint: object_length.
                                            dataname,
                                            parentname = ifelse(
                                              inherits(arm_var, "data_extract_spec"),
                                              teal.transform::datanames_input(arm_var),
                                              "ADSL"
                                            ),
                                            arm_var,
                                            id_var = teal.transform::choices_selected(
                                              teal.transform::variable_choices(
                                                dataname,
                                                subset = "USUBJID"
                                              ),
                                              selected = "USUBJID", fixed = TRUE
                                            ),
                                            paramcd,
                                            atoxgr_var = teal.transform::choices_selected(
                                              teal.transform::variable_choices(
                                                dataname,
                                                subset = "ATOXGR"
                                              ),
                                              selected = "ATOXGR", fixed = TRUE
                                            ),
                                            worst_high_flag_var = teal.transform::choices_selected(
                                              teal.transform::variable_choices(
                                                dataname,
                                                subset = "WGRHIFL"
                                              ),
                                              selected = "WGRHIFL", fixed = TRUE
                                            ),
                                            worst_low_flag_var = teal.transform::choices_selected(
                                              teal.transform::variable_choices(
                                                dataname,
                                                subset = "WGRLOFL"
                                              ),
                                              selected = "WGRLOFL", fixed = TRUE
                                            ),
                                            worst_flag_indicator = teal.transform::choices_selected("Y"),
                                            add_total = TRUE,
                                            total_label = default_total_label(),
                                            drop_arm_levels = TRUE,
                                            pre_output = NULL,
                                            post_output = NULL,
                                            basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_abnormality_by_worst_grade")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(total_label)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(id_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(atoxgr_var, "choices_selected")
  checkmate::assert_class(worst_high_flag_var, "choices_selected")
  checkmate::assert_class(worst_low_flag_var, "choices_selected")
  checkmate::assert_class(worst_flag_indicator, "choices_selected")
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    id_var = cs_to_des_select(id_var, dataname = dataname),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname, multiple = TRUE),
    atoxgr_var = cs_to_des_select(atoxgr_var, dataname = dataname),
    worst_high_flag_var = cs_to_des_select(worst_high_flag_var, dataname = dataname),
    worst_low_flag_var = cs_to_des_select(worst_low_flag_var, dataname = dataname)
  )

  args <- as.list(environment())

  module(
    label = label,
    ui = ui_t_abnormality_by_worst_grade,
    server = srv_t_abnormality_by_worst_grade,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        worst_flag_indicator = worst_flag_indicator,
        total_label = total_label,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_t_abnormality_by_worst_grade <- function(id, ...) { # nolint: object_length.

  ns <- NS(id)
  a <- list(...) # module args

  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$arm_var,
    a$id_var,
    a$paramcd,
    a$atoxgr_var,
    a$worst_high_flag_var,
    a$worst_low_flag_var,
    a$worst_flag_indicator
  )

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(
        a[c(
          "arm_var",
          "id_var",
          "paramcd",
          "atoxgr_var",
          "worst_high_flag_var",
          "worst_low_flag_var",
          "worst_flag_indicator"
        )]
      ),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      checkboxInput(ns("add_total"), "Add All Patients column", value = FALSE),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select Lab Parameter",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("atoxgr_var"),
        label = "Analysis toxicity grade",
        data_extract_spec = a$atoxgr_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("worst_low_flag_var"),
        label = "Worst low flag variable",
        data_extract_spec = a$worst_low_flag_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("worst_high_flag_var"),
        label = "Worst high flag variable",
        data_extract_spec = a$worst_high_flag_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional table settings",
          teal.transform::data_extract_ui(
            id = ns("id_var"),
            label = "Subject Identifier",
            data_extract_spec = a$id_var,
            is_single_dataset = is_single_dataset_value
          ),
          teal.widgets::optionalSelectInput(
            ns("worst_flag_indicator"),
            label = "Value Indicating Worst Grade",
            multiple = FALSE,
            fixed_on_single = TRUE
          ),
          checkboxInput(
            ns("drop_arm_levels"),
            label = "Drop columns not in filtered analysis dataset",
            value = a$drop_arm_levels
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length.
                                             data,
                                             reporter,
                                             filter_panel_api,
                                             dataname,
                                             parentname,
                                             id_var,
                                             arm_var,
                                             paramcd,
                                             atoxgr_var,
                                             worst_flag_indicator,
                                             worst_low_flag_var,
                                             worst_high_flag_var,
                                             add_total,
                                             total_label,
                                             drop_arm_levels,
                                             label,
                                             basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    isolate({
      resolved <- teal.transform::resolve_delayed(worst_flag_indicator, as.list(data()@env))
      teal.widgets::updateOptionalSelectInput(
        session = session,
        inputId = "worst_flag_indicator",
        choices = resolved$choices,
        selected = resolved$selected
      )
    })

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        arm_var = arm_var,
        id_var = id_var,
        paramcd = paramcd,
        atoxgr_var = atoxgr_var,
        worst_high_flag_var = worst_high_flag_var,
        worst_low_flag_var = worst_low_flag_var
      ),
      datasets = data,
      select_validation_rule = list(
        arm_var = shinyvalidate::sv_required("Please select a treatment variable."),
        id_var = shinyvalidate::sv_required("Please select a Subject Identifier."),
        atoxgr_var = shinyvalidate::sv_required("Please select Analysis Toxicity Grade variable."),
        worst_low_flag_var = shinyvalidate::sv_required("Please select the Worst Low Grade flag variable."),
        worst_high_flag_var = shinyvalidate::sv_required("Please select the Worst High Grade flag variable.")
      ),
      filter_validation_rule = list(
        paramcd = shinyvalidate::sv_required("Please select at least one Laboratory parameter.")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      teal.transform::compose_and_enable_validators(iv, selector_list)
      iv$add_rule(
        "worst_flag_indicator",
        ~ if (length(.) == 0) {
          "Please select the value indicating worst grade."
        }
      )
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      selector_list = selector_list,
      datasets = data,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    validate_checks <- reactive({
      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]
      anl <- merged$anl_q()[["ANL"]]

      input_arm_var <- names(merged$anl_input_r()$columns_source$arm_var)
      input_paramcd_var <- names(merged$anl_input_r()$columns_source$paramcd)
      input_atoxgr <- names(merged$anl_input_r()$columns_source$atoxgr_var)
      input_worst_high_flag_var <- names(merged$anl_input_r()$columns_source$worst_high_flag_var)
      input_worst_low_flag_var <- names(merged$anl_input_r()$columns_source$worst_low_flag_var)

      teal::validate_inputs(iv_r())

      if (length(input_paramcd_var) > 0) {
        validate(
          need(
            is.factor(anl[[input_paramcd_var]]),
            "Parameter variable should be a factor."
          )
        )
      }

      if (length(input_atoxgr) > 0) {
        validate(
          need(
            all(as.character(unique(anl[[input_atoxgr]])) %in% as.character(c(-4:4))),
            "All grade values should be within -4:4 range."
          ),
          need(
            is.factor(anl[[input_atoxgr]]),
            "Grade variable should be a factor."
          ),
          need(
            all(sapply(1:4, function(y) any(abs(as.numeric(as.character(anl[[input_atoxgr]]))) == y))),
            paste(
              "To display the table there must be at least one record for",
              "each highest grade (in either direction).\n\n",
              "Please remove filter(s) or select a different lab parameter."
            )
          )
        )
      }

      if (length(input_atoxgr) > 0) {
        validate(
          need(
            is.factor(anl[[input_atoxgr]]),
            "Treatment variable should be a factor."
          ),
        )
      }

      # validate inputs
      validate_standard_inputs(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var),
        anl = anl_filtered,
        anlvars = c(
          "USUBJID", "STUDYID", input_paramcd_var,
          input_atoxgr, input_worst_high_flag_var,
          input_worst_low_flag_var
        ),
        arm_var = input_arm_var
      )
    })

    all_q <- reactive({
      validate_checks()

      my_calls <- template_abnormality_by_worst_grade(
        parentname = "ANL_ADSL",
        dataname = "ANL",
        arm_var = names(merged$anl_input_r()$columns_source$arm_var),
        id_var = names(merged$anl_input_r()$columns_source$id_var),
        paramcd = names(merged$anl_input_r()$columns_source$paramcd),
        atoxgr_var = names(merged$anl_input_r()$columns_source$atoxgr_var),
        worst_high_flag_var = names(merged$anl_input_r()$columns_source$worst_high_flag_var),
        worst_low_flag_var = names(merged$anl_input_r()$columns_source$worst_low_flag_var),
        worst_flag_indicator = input$worst_flag_indicator,
        add_total = input$add_total,
        total_label = total_label,
        drop_arm_levels = input$drop_arm_levels,
        basic_table_args = basic_table_args
      )

      teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
    })

    # Outputs to render.
    table_r <- reactive(all_q()[["result"]])

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    # Render R code.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Laboratory Test Results Table",
          label = label,
          description = "Laboratory test results with highest grade post-baseline Table",
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: ANCOVA Summary
#'
#' Creates a valid expression to generate an analysis of variance summary table.
#'
#' @inheritParams template_arguments
#' @param paramcd_levels (`character`)\cr
#'   variable levels for the studied parameter.
#' @param paramcd_var (`character`)\cr
#'   variable name for the studied parameter.
#' @param visit_levels (`character`)\cr
#'   variable levels for studied visits.
#' @param label_aval (`character`)\cr
#'   label of value variable used for title rendering.
#' @param label_paramcd (`character`)\cr
#'   variable label used for title rendering.
#' @param interact_var (`character`)\cr name of the variable that should have interactions with arm. If the
#'   interaction is not needed, the default option is `NULL`.
#' @param interact_y (`character`)\cr a selected item from the `interact_var` column which will be used to select the
#'   specific ANCOVA results. If the interaction is not needed, the default option is `FALSE`.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_ancova()]
#'
#' @keywords internal
template_ancova <- function(dataname = "ANL",
                            parentname = "ADSL",
                            arm_var,
                            ref_arm = NULL,
                            comp_arm = NULL,
                            combine_comp_arms = FALSE,
                            aval_var,
                            label_aval = NULL,
                            cov_var,
                            include_interact = FALSE,
                            interact_var = NULL,
                            interact_y = FALSE,
                            paramcd_levels = "",
                            paramcd_var = "PARAMCD",
                            label_paramcd = NULL,
                            visit_levels = "",
                            visit_var = "AVISIT",
                            conf_level = 0.95,
                            basic_table_args = teal.widgets::basic_table_args()) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(arm_var)
  checkmate::assert_string(label_aval, null.ok = TRUE)
  checkmate::assert_flag(combine_comp_arms)
  checkmate::assert_string(aval_var)
  checkmate::assert_character(cov_var)
  checkmate::assert_flag(include_interact)
  if (!isFALSE(interact_y)) checkmate::assert_character(interact_y)
  checkmate::assert_string(interact_var, null.ok = TRUE)

  y <- list()

  if (include_interact && !any(interact_y == "") && !is.null(interact_var)) {
    cov_var <- c(cov_var, paste0(arm_var, "*", interact_var))
  }

  if (length(cov_var) == 0) {
    cov_var <- NULL
  }

  # Data processing.
  data_list <- list()
  anl_list <- list()
  parent_list <- list()
  ref_arm_val <- paste(ref_arm, collapse = "/")

  anl_list <- add_expr(
    anl_list,
    prepare_arm(
      dataname = dataname,
      arm_var = arm_var,
      ref_arm = ref_arm,
      comp_arm = comp_arm,
      ref_arm_val = ref_arm_val,
      drop = FALSE
    )
  )
  anl_list <- add_expr(anl_list, quote(droplevels()))

  parent_list <- add_expr(
    parent_list,
    prepare_arm(
      dataname = parentname,
      arm_var = arm_var,
      ref_arm = ref_arm,
      comp_arm = comp_arm,
      ref_arm_val = ref_arm_val,
      drop = FALSE
    )
  )
  parent_list <- add_expr(parent_list, quote(droplevels()))

  if (combine_comp_arms) {
    anl_list <- add_expr(
      anl_list,
      substitute_names(
        expr = dplyr::mutate(arm_var = combine_levels(arm_var, levels = comp_arm)),
        names = list(arm_var = as.name(arm_var)),
        others = list(comp_arm = comp_arm)
      )
    )
    parent_list <- add_expr(
      parent_list,
      substitute_names(
        expr = dplyr::mutate(arm_var = combine_levels(arm_var, levels = comp_arm)),
        names = list(arm_var = as.name(arm_var)),
        others = list(comp_arm = comp_arm)
      )
    )
  }

  anl_list <- add_expr(anl_list, quote(df_explicit_na(na_level = default_na_str())))
  parent_list <- add_expr(parent_list, quote(df_explicit_na(na_level = default_na_str())))

  data_list <- add_expr(
    data_list,
    substitute(
      anl <- anl_list,
      env = list(
        anl = as.name(dataname),
        anl_list = pipe_expr(anl_list)
      )
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      parent <- parent_list,
      env = list(
        parent = as.name(parentname),
        parent_list = pipe_expr(parent_list)
      )
    )
  )

  y$data <- bracket_expr(data_list)

  # Build layout.
  visits_title <- if (length(visit_levels) > 1) {
    paste(
      paste(utils::head(visit_levels, -1), collapse = ", "),
      "and", utils::tail(visit_levels, 1)
    )
  } else if (length(visit_levels) == 1) {
    visit_levels
  } else {
    ""
  }

  table_title <- if (length(label_paramcd) > 1) {
    paste(
      "Summary of Analysis of Variance for", paste(label_paramcd, collapse = " and "),
      "at", visits_title, "for", label_aval
    )
  } else if (length(label_paramcd == 1)) {
    paste("Summary of Analysis of Variance for", label_paramcd, "at", visits_title, "for", label_aval)
  } else {
    ""
  }

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(show_colcounts = TRUE, title = table_title)
    )
  )

  y$layout_prep <- quote(split_fun <- drop_split_levels)
  layout_list <- list()
  layout_list <- add_expr(
    layout_list,
    parsed_basic_table_args
  )

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = rtables::split_cols_by(var = arm_var, ref_group = ref_group) %>%
        rtables::split_rows_by(
          visit_var,
          split_fun = split_fun,
          label_pos = "topleft",
          split_label = teal.data::col_labels(dataname[visit_var], fill = TRUE)
        ),
      env = list(
        arm_var = arm_var,
        ref_group = paste(ref_arm, collapse = "/"),
        visit_var = visit_var,
        dataname = as.name(dataname)
      )
    )
  )

  if (length(paramcd_levels) > 1) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        rtables::split_rows_by(
          paramcd_var,
          split_fun = split_fun,
          label_pos = "topleft",
          split_label = teal.data::col_labels(dataname[paramcd_var], fill = TRUE)
        ),
        env = list(
          paramcd_var = paramcd_var,
          dataname = as.name(dataname)
        )
      )
    )
  } else {
    layout_list <- add_expr(
      layout_list,
      substitute(
        rtables::append_topleft(paste0("  ", paramcd_levels)),
        env = list(
          paramcd_levels = paramcd_levels
        )
      )
    )
  }

  if (!include_interact) {
    if (length(paramcd_levels) > 1) {
      if (length(cov_var) == 0) {
        ls_lbls <- c(lsmean = "Unadjusted Mean", lsmean_diff = "Difference in Unadjusted Means")
        var_lbls <- "Unadjusted mean"
      } else {
        ls_lbls <- NULL
        var_lbls <- "Adjusted mean"
      }
      layout_list <- add_expr(
        layout_list,
        substitute(
          summarize_ancova(
            vars = aval_var,
            variables = list(arm = arm_var, covariates = cov_var),
            conf_level = conf_level,
            var_labels = var_labels,
            show_labels = "hidden",
            .labels = ls_labels
          ),
          env = list(
            aval_var = aval_var,
            arm_var = arm_var,
            cov_var = cov_var,
            conf_level = conf_level,
            var_labels = var_lbls,
            ls_labels = ls_lbls
          )
        )
      )
    } else {
      # Only one entry in `paramcd_levels` here.
      layout_list <- add_expr(
        layout_list,
        substitute(
          summarize_ancova(
            vars = aval_var,
            variables = list(arm = arm_var, covariates = NULL),
            conf_level = conf_level,
            var_labels = "Unadjusted comparison",
            .labels = c(lsmean = "Mean", lsmean_diff = "Difference in Means"),
            table_names = "unadjusted_comparison"
          ),
          env = list(
            aval_var = aval_var,
            arm_var = arm_var,
            conf_level = conf_level
          )
        )
      )
      if (length(cov_var) > 0) {
        layout_list <- add_expr(
          layout_list,
          substitute(
            summarize_ancova(
              vars = aval_var,
              variables = list(arm = arm_var, covariates = cov_var),
              conf_level = conf_level,
              var_labels = paste0(
                "Adjusted comparison (", paste(cov_var, collapse = " + "), ")"
              ),
              table_names = "adjusted_comparison"
            ),
            env = list(
              aval_var = aval_var,
              arm_var = arm_var,
              cov_var = cov_var,
              conf_level = conf_level
            )
          )
        )
      }
    }
  } else {
    cts_interact <- all(interact_y == FALSE)
    layout_list <- add_expr(
      layout_list,
      substitute(
        rtables::append_topleft(paste0("    Interaction Variable: ", interact_var)),
        env = list(
          interact_var = interact_var
        )
      )
    )
    for (int_y in interact_y) {
      if (length(paramcd_levels) > 1) {
        layout_list <- add_expr(
          layout_list,
          substitute(
            summarize_ancova(
              vars = aval_var,
              variables = list(arm = arm_var, covariates = cov_var),
              conf_level = conf_level,
              var_labels = paste("Interaction Level:", interact_y),
              show_labels = if (cts_interact) "hidden" else "visible",
              interaction_y = interact_y,
              interaction_item = interact_var
            ),
            env = list(
              aval_var = aval_var,
              arm_var = arm_var,
              cov_var = cov_var,
              conf_level = conf_level,
              interact_y = int_y,
              interact_var = interact_var,
              cts_interact = cts_interact
            )
          )
        )
      } else {
        # Only one entry in `paramcd_levels` here.
        if (int_y == interact_y[1]) {
          layout_list <- add_expr(
            layout_list,
            substitute(
              summarize_ancova(
                vars = aval_var,
                variables = list(arm = arm_var, covariates = NULL),
                conf_level = conf_level,
                var_labels = "Unadjusted comparison",
                .labels = c(lsmean = "Mean", lsmean_diff = "Difference in Means"),
                table_names = "unadjusted_comparison"
              ),
              env = list(
                aval_var = aval_var,
                arm_var = arm_var,
                cov_var = cov_var,
                conf_level = conf_level
              )
            )
          )
        }
        if (length(cov_var) > 0) {
          layout_list <- add_expr(
            layout_list,
            substitute(
              summarize_ancova(
                vars = aval_var,
                variables = list(arm = arm_var, covariates = cov_var),
                conf_level = conf_level,
                var_labels = if (cts_interact) {
                  paste0("Adjusted comparison (", paste(cov_var, collapse = " + "), ")")
                } else {
                  paste0(
                    "Adjusted comparison (", paste(cov_var, collapse = " + "),
                    "), Interaction Level: ", interact_y
                  )
                },
                table_names = "adjusted_comparison",
                interaction_y = interact_y,
                interaction_item = interact_var
              ),
              env = list(
                aval_var = aval_var,
                arm_var = arm_var,
                cov_var = cov_var,
                conf_level = conf_level,
                interact_y = int_y,
                interact_var = interact_var,
                cts_interact = cts_interact
              )
            )
          )
        }
      }
    }
  }

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  # Build table.
  y$table <- substitute(
    expr = {
      result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
      result
    },
    env = list(
      anl = as.name(dataname),
      parent = as.name(parentname)
    )
  )

  y
}

#' teal Module: ANCOVA Summary
#'
#' This module produces a table to summarize analysis of variance, consistent with the TLG Catalog
#' template for `AOVT01` available [here](
#' https://insightsengineering.github.io/tlg-catalog/stable/tables/efficacy/aovt01.html) when multiple
#' endpoints are selected.
#'
#' @inheritParams module_arguments
#' @inheritParams template_ancova
#'
#' @inherit module_arguments return
#'
#' @details
#' When a single endpoint is selected, both unadjusted and adjusted comparison are provided. This modules
#' expects that the analysis data has the following variables:
#'
#' * `AVISIT`: variable used to filter for analysis visits.
#' * `PARAMCD`: variable used to filter for endpoints, after filtering for `paramcd` and `avisit`, one
#'   observation per patient is expected for the analysis to be meaningful.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' ADSL <- tmc_ex_adsl
#' ADQS <- tmc_ex_adqs
#'
#' arm_ref_comp <- list(
#'   ARM = list(
#'     ref = "B: Placebo",
#'     comp = c("A: Drug X", "C: Combination")
#'   ),
#'   ACTARMCD = list(
#'     ref = "ARM B",
#'     comp = c("ARM A", "ARM C")
#'   )
#' )
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADQS = ADQS,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADQS <- tmc_ex_adqs
#'     "
#'   ),
#'   modules = modules(
#'     tm_t_ancova(
#'       label = "ANCOVA Table",
#'       dataname = "ADQS",
#'       avisit = choices_selected(
#'         choices = value_choices(ADQS, "AVISIT"),
#'         selected = "WEEK 1 DAY 8"
#'       ),
#'       arm_var = choices_selected(
#'         choices = variable_choices(ADSL, c("ARM", "ACTARMCD", "ARMCD")),
#'         selected = "ARMCD"
#'       ),
#'       arm_ref_comp = arm_ref_comp,
#'       aval_var = choices_selected(
#'         choices = variable_choices(ADQS, c("CHG", "AVAL")),
#'         selected = "CHG"
#'       ),
#'       cov_var = choices_selected(
#'         choices = variable_choices(ADQS, c("BASE", "STRATA1", "SEX")),
#'         selected = "STRATA1"
#'       ),
#'       paramcd = choices_selected(
#'         choices = value_choices(ADQS, "PARAMCD", "PARAM"),
#'         selected = "FKSI-FWB"
#'       ),
#'       interact_var = choices_selected(
#'         choices = variable_choices(ADQS, c("BASE", "STRATA1", "SEX")),
#'         selected = "STRATA1"
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_ancova <- function(label,
                        dataname,
                        parentname = ifelse(
                          inherits(arm_var, "data_extract_spec"),
                          teal.transform::datanames_input(arm_var),
                          "ADSL"
                        ),
                        arm_var,
                        arm_ref_comp = NULL,
                        aval_var,
                        cov_var,
                        include_interact = FALSE,
                        interact_var = NULL,
                        interact_y = FALSE,
                        avisit,
                        paramcd,
                        conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE),
                        pre_output = NULL,
                        post_output = NULL,
                        basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_ancova")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(aval_var, "choices_selected")
  checkmate::assert_class(cov_var, "choices_selected")
  checkmate::assert_class(avisit, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(conf_level, "choices_selected")
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  args <- c(as.list(environment()))

  if (is.null(interact_var)) {
    interact_var <- teal.transform::choices_selected(
      choices = cov_var$choices,
      selected = NULL
    )
  }

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    aval_var = cs_to_des_select(aval_var, dataname = dataname),
    cov_var = cs_to_des_select(cov_var, dataname = dataname, multiple = TRUE),
    avisit = cs_to_des_filter(avisit, dataname = dataname, multiple = TRUE, include_vars = TRUE),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname, multiple = TRUE),
    interact_var = cs_to_des_select(interact_var, dataname = dataname)
  )

  module(
    label = label,
    ui = ui_ancova,
    ui_args = c(data_extract_list, args),
    server = srv_ancova,
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        arm_ref_comp = arm_ref_comp,
        include_interact = include_interact,
        label = label,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_ancova <- function(id, ...) {
  a <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$arm_var, a$aval_var, a$cov_var, a$avisit, a$paramcd, a$interact_var
  )

  ns <- NS(id)

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c("arm_var", "aval_var", "cov_var", "avisit", "paramcd", "interact_var")]),
      teal.transform::data_extract_ui(
        id = ns("avisit"),
        label = "Analysis Visit",
        data_extract_spec = a$avisit,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select Endpoint",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("aval_var"),
        label = "Analysis Variable",
        data_extract_spec = a$aval_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      uiOutput(
        ns("arms_buckets"),
        title = paste(
          "Multiple reference groups are automatically combined into a single group",
          "when more than one value is selected."
        )
      ),
      uiOutput(ns("helptext_ui")),
      checkboxInput(
        ns("combine_comp_arms"),
        "Combine all comparison groups?",
        value = FALSE
      ),
      teal.transform::data_extract_ui(
        id = ns("cov_var"),
        label = "Covariates",
        data_extract_spec = a$cov_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.widgets::optionalSelectInput(
        inputId = ns("conf_level"),
        label = HTML(paste("Confidence Level")),
        a$conf_level$choices,
        a$conf_level$selected,
        multiple = FALSE,
        fixed = a$conf_level$fixed
      ),
      tags$div(
        tags$label("Include Interaction Term"),
        shinyWidgets::switchInput(
          inputId = ns("include_interact"),
          value = FALSE,
          size = "mini"
        ),
        conditionalPanel(
          condition = paste0("input['", ns("include_interact"), "']"),
          tags$div(
            teal.transform::data_extract_ui(
              id = ns("interact_var"),
              label = "Select Interaction Variable",
              data_extract_spec = a$interact_var,
              is_single_dataset = is_single_dataset_value
            ),
            teal.widgets::optionalSelectInput(
              ns("interact_y"),
              label = "Select Interaction y",
              choices = "",
              selected = "",
              multiple = TRUE,
              fixed = FALSE
            )
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_ancova <- function(id,
                       data,
                       reporter,
                       filter_panel_api,
                       dataname,
                       parentname,
                       arm_var,
                       arm_ref_comp,
                       aval_var,
                       cov_var,
                       include_interact,
                       interact_var,
                       paramcd,
                       avisit,
                       label,
                       basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    # Setup arm variable selection, default reference arms, and default
    # comparison arms for encoding panel.
    iv_arco <- arm_ref_comp_observer(
      session,
      input,
      output,
      id_arm_var = extract_input("arm_var", parentname),
      data = data()[[parentname]],
      arm_ref_comp = arm_ref_comp,
      module = "tm_ancova"
    )

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        arm_var = arm_var,
        aval_var = aval_var,
        cov_var = cov_var,
        avisit = avisit,
        paramcd = paramcd,
        interact_var = interact_var
      ),
      datasets = data,
      select_validation_rule = list(
        arm_var = shinyvalidate::sv_required("Arm variable cannot be empty."),
        aval_var = shinyvalidate::sv_required("Analysis variable cannot be empty."),
        cov_var = shinyvalidate::sv_optional(),
        interact_var = shinyvalidate::sv_optional()
      ),
      filter_validation_rule = list(
        avisit = shinyvalidate::sv_required("`Analysis Visit` field cannot be empty."),
        paramcd = shinyvalidate::sv_required("`Select Endpoint` is not selected.")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level."))
      iv$add_rule("conf_level", shinyvalidate::sv_between(
        0, 1,
        message_fmt = "Confdence level must be between {left} and {right}."
      ))
      iv$add_validator(iv_arco)
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      selector_list = selector_list,
      datasets = data,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    output$helptext_ui <- renderUI({
      if (length(selector_list()$arm_var()$select) != 0) {
        helpText("Multiple reference groups are automatically combined into a single group.")
      }
    })

    # Event handler:
    # Update interact_y choices to all levels of selected interact_var
    observeEvent(
      {
        input$include_interact
        input$`interact_var-dataset_ADQS_singleextract-select`
      },
      {
        interact_var <- input$`interact_var-dataset_ADQS_singleextract-select`
        if (isTRUE(input$include_interact) && length(interact_var) > 0) {
          interact_choices <- sort(as.vector(unique(merged$anl_q()[[dataname]][[interact_var]])))
          if (all(is.numeric(interact_choices))) {
            shinyjs::hide("interact_y")
          } else {
            interact_select <- if (!all(input$interact_y %in% interact_choices)) {
              interact_choices[1]
            } else {
              input$interact_y
            }
            shinyjs::show("interact_y")
            teal.widgets::updateOptionalSelectInput(
              session,
              "interact_y",
              selected = interact_select,
              choices = interact_choices
            )
          }
        }
      }
    )

    # Prepare the analysis environment (filter data, check data, populate envir).
    validate_checks <- reactive({
      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]

      teal::validate_inputs(iv_r())

      input_arm_var <- as.vector(merged$anl_input_r()$columns_source$arm_var)
      input_aval_var <- as.vector(merged$anl_input_r()$columns_source$aval_var)
      input_cov_var <- as.vector(merged$anl_input_r()$columns_source$cov_var)
      input_interact_var <- as.vector(merged$anl_input_r()$columns_source$interact_var)
      input_avisit <- unlist(avisit$filter)["vars_selected"]
      input_paramcd <- unlist(paramcd$filter)["vars_selected"]

      # Validate inputs.
      validate_args <- list(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var),
        anl = anl_filtered,
        anlvars = c(
          "USUBJID", "STUDYID", input_paramcd, input_avisit, input_aval_var, input_cov_var, input_interact_var
        ),
        arm_var = input_arm_var
      )
      validate_args <- append(
        validate_args,
        list(ref_arm = unlist(input$buckets$Ref), comp_arm = unlist(input$buckets$Comp))
      )
      do.call(what = "validate_standard_inputs", validate_args)

      # Other validations.
      validate(shiny::need(
        length(unique(adsl_filtered[[input_arm_var]])) > 1,
        "ANCOVA table needs at least 2 arm groups to make comparisons."
      ))
      # check that there is at least one record with no missing data
      validate(shiny::need(
        !all(is.na(merged$anl_q()[["ANL"]][[input_aval_var]])),
        "ANCOVA table cannot be calculated as all values are missing."
      ))
      # check that for each visit there is at least one record with no missing data
      all_NA_dataset <- merged$anl_q()[["ANL"]] %>% # nolint: object_name.
        dplyr::group_by(dplyr::across(dplyr::all_of(c(input_avisit, input_arm_var)))) %>%
        dplyr::summarize(all_NA = all(is.na(.data[[input_aval_var]])))
      validate(shiny::need(
        !any(all_NA_dataset$all_NA),
        "ANCOVA table cannot be calculated as all values are missing for one visit for (at least) one arm."
      ))

      if (input$include_interact) {
        if (!is.null(input_interact_var) && length(input_interact_var) > 0) {
          validate(shiny::need(
            !input_interact_var %in% c(input_avisit, input_paramcd) &&
              length(as.vector(unique(anl_filtered[[input_interact_var]]))) > 1,
            paste(
              "Interaction variable cannot be a filter variable and must have more than one level.",
              "Please select a different interaction variable."
            )
          ))
          if (!all(is.numeric(as.vector(unique(anl_filtered[[input_interact_var]]))))) {
            validate(shiny::need(
              !is.null(input$interact_y),
              paste(
                "Interaction y must be selected when a discrete variable is chosen for interact variable.",
                "Please select an interaction y, change the interaction variable, or turn off interactions."
              )
            ))
          }
        }
      }

      if (length(input_cov_var >= 1L)) {
        input_cov_var_dataset <- anl_filtered[input_cov_var]
        validate(
          need(
            all(vapply(input_cov_var_dataset, function(col) length(unique(col)) > 1L, logical(1))),
            "Selected covariates should have more than one level for showing the adjusted analysis."
          )
        )
      }
    })

    # The R-code corresponding to the analysis.
    table_q <- reactive({
      validate_checks()
      ANL <- merged$anl_q()[["ANL"]]

      label_paramcd <- get_paramcd_label(ANL, paramcd)
      input_aval <- as.vector(merged$anl_input_r()$columns_source$aval_var)
      label_aval <- if (length(input_aval) != 0) attributes(ANL[[input_aval]])$label else NULL
      paramcd_levels <- unique(ANL[[unlist(paramcd$filter)["vars_selected"]]])
      visit_levels <- unique(ANL[[unlist(avisit$filter)["vars_selected"]]])

      interact_var <- as.vector(merged$anl_input_r()$columns_source$interact_var)
      if (length(interact_var) > 0) {
        if (is.numeric(ANL[[interact_var]])) {
          interact_y <- FALSE
        } else if (!all(input$interact_y %in% levels(ANL[[interact_var]]))) {
          interact_y <- levels(ANL[[interact_var]])[1]
        } else {
          interact_y <- input$interact_y
        }
      } else {
        interact_var <- NULL
        if (length(input$interact_y) == 0 || all(input$interact_y == "")) {
          interact_y <- FALSE
        }
      }

      my_calls <- template_ancova(
        parentname = "ANL_ADSL",
        dataname = "ANL",
        arm_var = as.vector(merged$anl_input_r()$columns_source$arm_var),
        ref_arm = unlist(input$buckets$Ref),
        comp_arm = unlist(input$buckets$Comp),
        combine_comp_arms = input$combine_comp_arms,
        aval_var = as.vector(merged$anl_input_r()$columns_source$aval_var),
        label_aval = label_aval,
        cov_var = as.vector(merged$anl_input_r()$columns_source$cov_var),
        include_interact = input$include_interact,
        interact_var = interact_var,
        interact_y = interact_y,
        paramcd_levels = paramcd_levels,
        paramcd_var = unlist(paramcd$filter)["vars_selected"],
        label_paramcd = label_paramcd,
        visit_levels = visit_levels,
        visit_var = unlist(avisit$filter)["vars_selected"],
        conf_level = as.numeric(input$conf_level),
        basic_table_args = basic_table_args
      )
      teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
    })

    # Output to render.
    table_r <- reactive({
      table_q()[["result"]]
    })

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    # Render R code.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(table_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "ANCOVA",
          label = label,
          description = "Analysis of Covariance",
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(table_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Shift by Arm
#'
#' Creates a valid expression to generate a summary table of analysis indicator levels by arm.
#'
#' @inheritParams template_arguments
#' @param aval_var (`character`)\cr name of the analysis reference range indicator variable.
#' @param baseline_var (`character`)\cr name of the baseline reference range indicator variable.
#' @param add_total (`logical`)\cr whether to include row with total number of patients.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_shift_by_arm()]
#'
#' @keywords internal
template_shift_by_arm <- function(dataname,
                                  parentname,
                                  arm_var = "ARM",
                                  paramcd = "PARAMCD",
                                  visit_var = "AVISIT",
                                  treatment_flag_var = "ONTRTFL",
                                  treatment_flag = "Y",
                                  aval_var = "ANRIND",
                                  base_var = lifecycle::deprecated(),
                                  baseline_var = "BNRIND",
                                  na.rm = FALSE, # nolint: object_name.
                                  na_level = default_na_str(),
                                  add_total = FALSE,
                                  total_label = default_total_label(),
                                  basic_table_args = teal.widgets::basic_table_args()) {
  if (lifecycle::is_present(base_var)) {
    baseline_var <- base_var
    warning(
      "The `base_var` argument of `template_shift_by_arm()` is deprecated as of teal.modules.clinical 0.8.16. ",
      "Please use the `baseline_var` argument instead.",
      call. = FALSE
    )
  }

  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(arm_var)
  checkmate::assert_string(visit_var)
  checkmate::assert_string(paramcd, na.ok = TRUE)
  checkmate::assert_string(aval_var)
  checkmate::assert_string(baseline_var)
  checkmate::assert_flag(na.rm)
  checkmate::assert_string(na_level)
  checkmate::assert_string(treatment_flag_var)
  checkmate::assert_string(treatment_flag)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)

  y <- list()

  # Start data steps.
  data_list <- list()
  data_list <- add_expr(
    data_list,
    substitute(
      expr = parentname <- df_explicit_na(parentname, na_level = na_str),
      env = list(parentname = as.name(parentname), na_str = na_level)
    )
  )
  data_list <- add_expr(
    data_list,
    substitute(
      expr = dataname <- df_explicit_na(dataname, na_level = na_str) %>%
        dplyr::filter(treatment_flag_var == treatment_flag),
      env = list(
        dataname = as.name(dataname),
        na_str = na_level,
        treatment_flag_var = as.name(treatment_flag_var),
        treatment_flag = treatment_flag
      )
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = attr(dataname$baseline_var, "label") <- "Baseline Assessment",
      env = list(dataname = as.name(dataname), baseline_var = baseline_var)
    )
  )

  y$data <- bracket_expr(data_list)

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args
    )
  )

  # Start layout steps.
  layout_list <- list()

  if (add_total) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = expr_basic_table_args %>%
          rtables::split_cols_by(visit_var, split_fun = drop_split_levels) %>% # temp solution for over arching column
          rtables::split_cols_by(aval_var) %>%
          rtables::split_rows_by(
            arm_var,
            split_fun = add_overall_level(total_label, first = FALSE),
            label_pos = "topleft",
            split_label = obj_label(dataname$arm_var)
          ) %>%
          add_rowcounts() %>%
          analyze_vars(
            baseline_var,
            denom = "N_row",
            na_str = na_str,
            na.rm = na.rm,
            .stats = "count_fraction"
          ) %>%
          append_varlabels(dataname, baseline_var, indent = 1L),
        env = list(
          aval_var = aval_var,
          arm_var = arm_var,
          baseline_var = baseline_var,
          dataname = as.name(dataname),
          visit_var = visit_var,
          na.rm = na.rm,
          na_str = na_level,
          total_label = total_label,
          expr_basic_table_args = parsed_basic_table_args
        )
      )
    )
  } else {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = expr_basic_table_args %>%
          rtables::split_cols_by(visit_var, split_fun = drop_split_levels) %>% # temp solution for over arching column
          rtables::split_cols_by(aval_var) %>%
          rtables::split_rows_by(
            arm_var,
            split_fun = drop_split_levels,
            label_pos = "topleft",
            split_label = obj_label(dataname$arm_var)
          ) %>%
          add_rowcounts() %>%
          analyze_vars(
            baseline_var,
            denom = "N_row",
            na_str = na_str,
            na.rm = na.rm,
            .stats = "count_fraction"
          ) %>%
          append_varlabels(dataname, baseline_var, indent = 1L),
        env = list(
          aval_var = aval_var,
          arm_var = arm_var,
          baseline_var = baseline_var,
          dataname = as.name(dataname),
          visit_var = visit_var,
          na.rm = na.rm,
          na_str = na_level,
          expr_basic_table_args = parsed_basic_table_args
        )
      )
    )
  }

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  # Full table.
  y$table <- substitute(
    expr = {
      result <- rtables::build_table(lyt = lyt, df = dataname)
      result
    },
    env = list(dataname = as.name(dataname))
  )

  y
}

#' teal Module: Shift by Arm
#'
#' This module produces a summary table of analysis indicator levels by arm.
#'
#' @inheritParams module_arguments
#' @inheritParams template_shift_by_arm
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' ADSL <- tmc_ex_adsl
#' ADEG <- tmc_ex_adeg
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADEG = ADEG,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADEG <- tmc_ex_adeg
#'     "
#'   ),
#'   modules = modules(
#'     tm_t_shift_by_arm(
#'       label = "Shift by Arm Table",
#'       dataname = "ADEG",
#'       arm_var = choices_selected(
#'         variable_choices(ADSL, subset = c("ARM", "ARMCD")),
#'         selected = "ARM"
#'       ),
#'       paramcd = choices_selected(
#'         value_choices(ADEG, "PARAMCD"),
#'         selected = "HR"
#'       ),
#'       visit_var = choices_selected(
#'         value_choices(ADEG, "AVISIT"),
#'         selected = "POST-BASELINE MINIMUM"
#'       ),
#'       aval_var = choices_selected(
#'         variable_choices(ADEG, subset = "ANRIND"),
#'         selected = "ANRIND", fixed = TRUE
#'       ),
#'       baseline_var = choices_selected(
#'         variable_choices(ADEG, subset = "BNRIND"),
#'         selected = "BNRIND", fixed = TRUE
#'       ),
#'       useNA = "ifany"
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_shift_by_arm <- function(label,
                              dataname,
                              parentname = ifelse(
                                inherits(arm_var, "data_extract_spec"),
                                teal.transform::datanames_input(arm_var),
                                "ADSL"
                              ),
                              arm_var,
                              paramcd,
                              visit_var,
                              aval_var,
                              base_var = lifecycle::deprecated(),
                              baseline_var,
                              treatment_flag_var = teal.transform::choices_selected(
                                teal.transform::variable_choices(dataname, subset = "ONTRTFL"),
                                selected = "ONTRTFL"
                              ),
                              treatment_flag = teal.transform::choices_selected("Y"),
                              useNA = c("ifany", "no"), # nolint: object_name.
                              na_level = default_na_str(),
                              add_total = FALSE,
                              total_label = default_total_label(),
                              pre_output = NULL,
                              post_output = NULL,
                              basic_table_args = teal.widgets::basic_table_args()) {
  if (lifecycle::is_present(base_var)) {
    baseline_var <- base_var
    warning(
      "The `base_var` argument of `tm_t_shift_by_arm()` is deprecated as of teal.modules.clinical 0.8.16. ",
      "Please use the `baseline_var` argument instead.",
      call. = FALSE
    )
  } else {
    base_var <- baseline_var # resolves missing argument error
  }

  message("Initializing tm_t_shift_by_arm")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  useNA <- match.arg(useNA) # nolint: object_name.
  checkmate::assert_string(na_level)
  checkmate::assert_string(total_label)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(visit_var, "choices_selected")
  checkmate::assert_class(aval_var, "choices_selected")
  checkmate::assert_class(baseline_var, "choices_selected")
  checkmate::assert_class(treatment_flag_var, "choices_selected")
  checkmate::assert_class(treatment_flag, "choices_selected")
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  args <- as.list(environment())

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname),
    visit_var = cs_to_des_filter(visit_var, dataname = dataname),
    treatment_flag_var = cs_to_des_select(treatment_flag_var, dataname = dataname),
    aval_var = cs_to_des_select(aval_var, dataname = dataname),
    baseline_var = cs_to_des_select(baseline_var, dataname = dataname)
  )

  module(
    label = label,
    server = srv_shift_by_arm,
    ui = ui_shift_by_arm,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        total_label = total_label,
        na_level = na_level,
        treatment_flag = treatment_flag,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_shift_by_arm <- function(id, ...) {
  ns <- NS(id)
  a <- list(...)

  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$id_var,
    a$arm_var,
    a$paramcd,
    a$visit_var,
    a$treatment_flag_var,
    a$treatment_flag,
    a$aval_var,
    a$baseline_var
  )

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c(
        "arm_var", "paramcd_var", "paramcd", "aval_var", "baseline_var", "visit_var", "treamtment_flag_var"
      )]),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select Endpoint",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("visit_var"),
        label = "Select Visit",
        data_extract_spec = a$visit_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("aval_var"),
        label = "Select Analysis Range Indicator Variable",
        data_extract_spec = a$aval_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("baseline_var"),
        label = "Select Baseline Reference Range Indicator Variable",
        data_extract_spec = a$baseline_var,
        is_single_dataset = is_single_dataset_value
      ),
      checkboxInput(ns("add_total"), "Add All Patients row", value = a$add_total),
      radioButtons(
        ns("useNA"),
        label = "Display NA counts",
        choices = c("ifany", "no"),
        selected = a$useNA
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional Variables Info",
          teal.transform::data_extract_ui(
            id = ns("treatment_flag_var"),
            label = "On Treatment Flag Variable",
            data_extract_spec = a$treatment_flag_var,
            is_single_dataset = is_single_dataset_value
          ),
          teal.widgets::optionalSelectInput(
            ns("treatment_flag"),
            label = "Value Indicating On Treatment",
            multiple = FALSE,
            fixed_on_single = TRUE
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_shift_by_arm <- function(id,
                             data,
                             reporter,
                             filter_panel_api,
                             dataname,
                             parentname,
                             arm_var,
                             paramcd,
                             visit_var,
                             treatment_flag_var,
                             treatment_flag,
                             aval_var,
                             baseline_var,
                             label,
                             na_level,
                             add_total,
                             total_label,
                             basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")
  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        arm_var = arm_var,
        paramcd = paramcd,
        visit_var = visit_var,
        aval_var = aval_var,
        baseline_var = baseline_var,
        treatment_flag_var = treatment_flag_var
      ),
      datasets = data,
      select_validation_rule = list(
        aval_var = shinyvalidate::sv_required("An analysis range indicator required"),
        arm_var = shinyvalidate::sv_required("A treatment variable is required"),
        treatment_flag_var = shinyvalidate::sv_required("An on treatment flag variable is required"),
        baseline_var = shinyvalidate::sv_required("A baseline reference range indicator is required")
      ),
      filter_validation_rule = list(
        paramcd = shinyvalidate::sv_required("An endpoint is required"),
        visit_var = shinyvalidate::sv_required("A visit is required")
      )
    )

    isolate({
      resolved <- teal.transform::resolve_delayed(treatment_flag, as.list(data()@env))
      teal.widgets::updateOptionalSelectInput(
        session = session,
        inputId = "treatment_flag",
        choices = resolved$choices,
        selected = resolved$selected
      )
    })

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule(
        "treatment_flag",
        shinyvalidate::sv_required("An indicator value for on treatment records is required")
      )
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    # validate inputs
    validate_checks <- reactive({
      teal::validate_inputs(iv_r())

      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]

      input_arm_var <- names(merged$anl_input_r()$columns_source$arm_var)
      input_aval_var <- names(merged$anl_input_r()$columns_source$aval_var)
      input_baseline_var <- names(merged$anl_input_r()$columns_source$baseline_var)
      input_treatment_flag_var <- names(merged$anl_input_r()$columns_source$treatment_flag_var)

      validate(
        need(
          nrow(merged$anl_q()[["ANL"]]) > 0,
          paste0(
            "Please make sure the analysis dataset is not empty or\n",
            "endpoint parameter and analysis visit are selected."
          )
        )
      )

      validate_standard_inputs(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_aval_var, input_baseline_var),
        arm_var = input_arm_var
      )
    })

    # generate r code for the analysis
    all_q <- reactive({
      validate_checks()

      my_calls <- template_shift_by_arm(
        dataname = "ANL",
        parentname = "ANL_ADSL",
        arm_var = names(merged$anl_input_r()$columns_source$arm_var),
        paramcd = unlist(merged$anl_input_r()$filter)["vars_selected"],
        treatment_flag_var = names(merged$anl_input_r()$columns_source$treatment_flag_var),
        treatment_flag = input$treatment_flag,
        aval_var = names(merged$anl_input_r()$columns_source$aval_var),
        baseline_var = names(merged$anl_input_r()$columns_source$baseline_var),
        na.rm = ifelse(input$useNA == "ifany", FALSE, TRUE),
        na_level = na_level,
        add_total = input$add_total,
        total_label = total_label,
        basic_table_args = basic_table_args
      )

      teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
    })

    # Outputs to render.
    table_r <- reactive(all_q()[["result"]])

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    # Render R code.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Shift by Arm Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Parse text input to numeric vector
#'
#' Generic to parse text into numeric vectors. This was initially designed
#' for a robust interpretation of text input in teal modules.
#'
#' @param str (`vector`)\cr to extract numeric from.
#' @details The function is intended to extract any numeric from a character
#'   string, factor levels, boolean and return a vector of numeric.
#'
#' @md
#'
#' @return As vector of numeric if directly parsed from `numeric` or boolean.
#'   A list of numeric if parsed from a character string, each character string
#'   associated with an list item.
#'
#' @examples
#' dta <- list(
#'   character = c("text10,20.5letter30.!", "!-.40$$-50e5[", NA),
#'   factor    = factor(c("]+60e-6, 7.7%%8L", "%90sep.100\"1L", NA_character_)),
#'   numeric   = c(1, -5e+2, NA),
#'   logical   = c(TRUE, FALSE, NA)
#' )
#' lapply(dta, as_num)
#' @export
as_num <- function(str) {
  UseMethod("as_num")
}

#' @export
#' @rdname as_num
as_num.default <- function(str) {
  stop("No default implementation for `as_num.default`.")
}

#' @export
#' @rdname as_num
as_num.character <- function(str) {
  y <- regmatches(
    x = str,
    m = gregexpr(
      "[-+]?(\\d+(\\.\\d*)?|\\.\\d+)([eE][-+]?\\d+)?",
      str,
      perl = TRUE
    )
  )

  y <- lapply(y, as.numeric)
  y[unlist(lapply(y, length) == 0)] <- NA

  return(y)
}

#' @export
#' @rdname as_num
as_num.numeric <- function(str) {
  return(str)
}

#' @export
#' @rdname as_num
as_num.factor <- function(str) {
  y <- as.character(str)
  y <- as_num(y)
  return(y)
}

#' @export
#' @rdname as_num
as_num.logical <- function(str) {
  y <- as.numeric(str)
  return(y)
}

#' Template: Adverse Events Summary
#'
#' Creates a valid expression to generate an adverse events summary table.
#'
#' @inheritParams template_arguments
#' @param dthfl_var (`character`)\cr name of variable for subject death flag from `parentname`.
#'   Records with `"Y"` are summarized in the table row for "Total number of deaths".
#' @param dcsreas_var (`character`)\cr name of variable for study discontinuation reason from `parentname`.
#'   Records with `"ADVERSE EVENTS"` are summarized in the table row for
#'   "Total number of patients withdrawn from study due to an AE".
#' @param flag_var_anl (`character`)\cr name of flag variable from `dataset` used to count adverse event sub-groups
#'   (e.g. Serious events, Related events, etc.). Variable labels are used as table row names if they exist.
#' @param flag_var_aesi (`character`)\cr name of flag variable from `dataset` used to count adverse event special
#'   interest groups. All flag variables must be of type `logical`. Variable labels are used as table row names if
#'   they exist.
#' @param aeseq_var (`character`)\cr name of variable for adverse events sequence number from `dataset`. Used for
#'   counting total number of events.
#' @param count_dth (`logical`)\cr whether to show count of total deaths (based on `dthfl_var`). Defaults to `TRUE`.
#' @param count_wd (`logical`)\cr whether to show count of patients withdrawn from study due to an adverse event
#'   (based on `dcsreas_var`). Defaults to `TRUE`.
#' @param count_subj (`logical`)\cr whether to show count of unique subjects (based on `USUBJID`). Only applies if
#'   event flag variables are provided.
#' @param count_pt (`logical`)\cr whether to show count of unique preferred terms (based on `llt`). Only applies if
#'   event flag variables are provided.
#' @param count_events (`logical`)\cr whether to show count of events (based on `aeseq_var`). Only applies if event
#'   flag variables are provided.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_events_summary()]
#'
#' @keywords internal
template_events_summary <- function(anl_name,
                                    parentname,
                                    arm_var,
                                    dthfl_var = "DTHFL",
                                    dcsreas_var = "DCSREAS",
                                    flag_var_anl = NULL,
                                    flag_var_aesi = NULL,
                                    aeseq_var = "AESEQ",
                                    llt = "AEDECOD",
                                    add_total = TRUE,
                                    total_label = default_total_label(),
                                    na_level = default_na_str(),
                                    count_dth = TRUE,
                                    count_wd = TRUE,
                                    count_subj = TRUE,
                                    count_pt = TRUE,
                                    count_events = TRUE) {
  checkmate::assert_string(anl_name)
  checkmate::assert_string(parentname)
  checkmate::assert_character(arm_var, min.len = 1, max.len = 2)
  checkmate::assert_string(dthfl_var)
  checkmate::assert_string(dcsreas_var)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_string(na_level)
  checkmate::assert_character(flag_var_anl, null.ok = TRUE)
  checkmate::assert_character(flag_var_aesi, null.ok = TRUE)
  checkmate::assert_string(aeseq_var)
  checkmate::assert_string(llt)
  checkmate::assert_flag(count_dth)
  checkmate::assert_flag(count_wd)
  checkmate::assert_flag(count_subj)
  checkmate::assert_flag(count_pt)
  checkmate::assert_flag(count_events)

  y <- list()

  data_list <- list()
  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl <- anl_name,
      env = list(anl_name = as.name(anl_name))
    )
  )

  # Since this is a compound table with one layout based on `parentname`
  # and one layout on `dataname`, columns will be filtered to match levels
  # present in `parentname` only so `drop_arm_levels` = FALSE.
  data_list <- add_expr(
    data_list,
    prepare_arm_levels(
      dataname = "anl",
      parentname = parentname,
      arm_var = arm_var[[1]],
      drop_arm_levels = FALSE
    )
  )
  if (length(arm_var) == 2) {
    data_list <- add_expr(
      data_list,
      prepare_arm_levels(
        dataname = "anl",
        parentname = parentname,
        arm_var = arm_var[[2]],
        drop_arm_levels = FALSE
      )
    )
  }

  data_list <- add_expr(
    data_list,
    quote(study_id <- unique(anl[["STUDYID"]]))
  )

  # Create dummy variable for counting patients with an AE
  data_list <- add_expr(
    data_list,
    quote(anl$tmp_aefl <- "Y")
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = {
        anl[[a]] <- as.character(anl[[a]])
        anl <- anl %>%
          dplyr::mutate(
            USUBJID_AESEQ = paste(usubjid, aeseq_var, sep = "@@")
          )
      },
      env = list(
        a = llt,
        usubjid = as.name("USUBJID"),
        aeseq_var = as.name(aeseq_var)
      )
    )
  )

  if (length(flag_var_anl) > 0) {
    data_list <- add_expr(
      data_list,
      substitute(
        flag_var_anl_label <- teal.data::col_labels(anl[, flag_var_anl], fill = FALSE),
        env = list(flag_var_anl = flag_var_anl)
      )
    )
  }

  if (length(flag_var_aesi) > 0) {
    data_list <- add_expr(
      data_list,
      substitute(
        flag_var_aesi_label <- teal.data::col_labels(anl[, flag_var_aesi], fill = FALSE),
        env = list(flag_var_aesi = flag_var_aesi)
      )
    )
  }

  data_list <- add_expr(
    data_list,
    substitute(
      expr = dataname <- df_explicit_na(dataname, na_level = na_str),
      env = list(dataname = as.name("anl"), na_str = na_level)
    )
  )
  data_list <- add_expr(
    data_list,
    substitute(
      expr = parentname <- df_explicit_na(parentname, na_level = na_str),
      env = list(parentname = as.name(parentname), na_str = na_level)
    )
  )

  y$data <- bracket_expr(data_list)

  # Layout to be used with `parentname` dataset
  # because not all subjects may exist in `anl_name` dataset.
  layout_parent_list <- list()
  layout_parent_list <- add_expr(
    layout_parent_list,
    quote(rtables::basic_table(show_colcounts = TRUE))
  )

  layout_parent_list <- add_expr(
    layout_parent_list,
    substitute(
      expr = rtables::split_cols_by(var = arm_var),
      env = list(arm_var = arm_var[[1]])
    )
  )
  if (length(arm_var) == 2) {
    layout_parent_list <- add_expr(
      layout_parent_list,
      substitute(
        expr = rtables::split_cols_by(nested_col, split_fun = drop_split_levels),
        env = list(nested_col = arm_var[[2]])
      )
    )
  }

  if (add_total) {
    layout_parent_list <- add_expr(
      layout_parent_list,
      substitute(
        expr = rtables::add_overall_col(label = total_label),
        env = list(total_label = total_label)
      )
    )
  }

  if (count_dth) {
    layout_parent_list <- add_expr(
      layout_parent_list,
      substitute(
        expr = count_values(
          dthfl_var,
          values = "Y",
          .labels = c(count_fraction = "Total number of deaths"),
          .formats = c(count_fraction = format_count_fraction),
          denom = "N_col"
        ),
        env = list(dthfl_var = dthfl_var)
      )
    )
  }

  if (count_wd) {
    layout_parent_list <- add_expr(
      layout_parent_list,
      substitute(
        expr = count_values(
          dcsreas_var,
          values = "ADVERSE EVENT",
          .labels = c(count_fraction = "Total number of patients withdrawn from study due to an AE"),
          .formats = c(count_fraction = format_count_fraction),
          denom = "N_col"
        ),
        env = list(dcsreas_var = dcsreas_var)
      )
    )
  }

  y$layout_parent <- substitute(
    expr = lyt_parent <- layout_parent_pipe,
    env = list(
      layout_parent_pipe = pipe_expr(layout_parent_list)
    )
  )

  table_parent_list <- list()
  table_parent_list <- add_expr(
    table_parent_list,
    substitute(
      expr = result_parent <- rtables::build_table(lyt = lyt_parent, df = df_parent, alt_counts_df = df_parent),
      env = list(df_parent = as.name(parentname))
    )
  )
  y$table_parent <- pipe_expr(table_parent_list)

  layout_anl_list <- list()
  layout_anl_list <- add_expr(
    layout_anl_list,
    quote(rtables::basic_table(show_colcounts = TRUE))
  )

  layout_anl_list <- add_expr(
    layout_anl_list,
    substitute(
      expr = rtables::split_cols_by(var = arm_var),
      env = list(arm_var = arm_var[[1]])
    )
  )
  if (length(arm_var) == 2) {
    layout_anl_list <- add_expr(
      layout_anl_list,
      substitute(
        expr = rtables::split_cols_by(nested_col, split_fun = drop_split_levels),
        env = list(nested_col = arm_var[[2]])
      )
    )
  }

  if (add_total) {
    layout_anl_list <- add_expr(
      layout_anl_list,
      substitute(
        expr = rtables::add_overall_col(label = tot_label),
        env = list(tot_label = total_label)
      )
    )
  }

  layout_anl_list <- add_expr(
    layout_anl_list,
    quote(
      expr = count_patients_with_event(
        vars = "USUBJID",
        filters = c("tmp_aefl" = "Y"),
        denom = "N_col",
        .stats = "count_fraction",
        .labels = c(
          count_fraction = "Total number of patients with at least one adverse event"
        ),
        .indent_mods = c(count_fraction = 0L),
        table_names = "total_pts_at_least_one"
      ) %>% count_values(
        "STUDYID",
        values = study_id,
        .stats = "count",
        .labels = c(count = "Total AEs"),
        table_names = "total_aes"
      )
    )
  )

  table_anl_list <- list()
  table_anl_list <- add_expr(
    table_anl_list,
    substitute(
      expr = result_anl <- rtables::build_table(lyt = lyt_anl, df = anl, alt_counts_df = df_parent),
      env = list(df_parent = as.name(parentname))
    )
  )

  condition1 <- count_subj && is.character(flag_var_anl)
  if (condition1) {
    layout_anl_list <- add_expr(
      layout_anl_list,
      substitute(
        expr = count_patients_with_flags(
          var = "USUBJID",
          flag_variables = flag_var_anl_label,
          table_names = "count_subj_anl",
          denom = "N_col",
          var_labels = "Total number of patients with at least one",
          show_labels = "visible"
        ),
        env = list(flag_var_anl = flag_var_anl)
      )
    )
  }

  condition2 <- count_pt && is.character(flag_var_anl)
  if (condition2) {
    layout_anl_list <- add_expr(
      layout_anl_list,
      substitute(
        expr = count_patients_with_flags(
          var = llt,
          flag_variables = flag_var_anl_label,
          table_names = "count_pt_anl",
          .stats = "count",
          .formats = c(count = "xx"),
          denom = "N_col",
          var_labels = "Total number of unique preferred terms which are",
          show_labels = "visible"
        ),
        env = list(flag_var_anl = flag_var_anl, llt = llt)
      )
    )
  }

  condition3 <- count_events && is.character(flag_var_anl)
  if (condition3) {
    layout_anl_list <- add_expr(
      layout_anl_list,
      substitute(
        expr = count_patients_with_flags(
          var = "USUBJID_AESEQ",
          flag_variables = flag_var_anl_label,
          table_names = "count_events_anl",
          .stats = "count",
          .formats = c(count = "xx"),
          denom = "N_col",
          var_labels = "Total number of adverse events which are",
          show_labels = "visible"
        ),
        env = list(flag_var_anl = flag_var_anl)
      )
    )
  }

  condition4 <- count_subj && is.character(flag_var_aesi)
  if (condition4) {
    layout_anl_list <- add_expr(
      layout_anl_list,
      substitute(
        expr = count_patients_with_flags(
          var = "USUBJID",
          flag_variables = flag_var_aesi_label,
          table_names = "count_subj_aesi",
          denom = "N_col",
          var_labels = "Medical concepts: number of patients with",
          show_labels = "visible"
        ),
        env = list(flag_var_aesi = flag_var_aesi)
      )
    )
  }

  condition5 <- count_pt && is.character(flag_var_aesi)
  if (condition5) {
    layout_anl_list <- add_expr(
      layout_anl_list,
      substitute(
        expr = count_patients_with_flags(
          var = llt,
          flag_variables = flag_var_aesi_label,
          table_names = "count_pt_aesi",
          .stats = "count",
          .formats = c(count = "xx"),
          denom = "N_col",
          var_labels = "Medical concepts: number of unique preferred terms which are part of",
          show_labels = "visible"
        ),
        env = list(flag_var_aesi = flag_var_aesi, llt = llt)
      )
    )
  }

  condition6 <- count_events && is.character(flag_var_aesi)
  if (condition6) {
    layout_anl_list <- add_expr(
      layout_anl_list,
      substitute(
        expr = count_patients_with_flags(
          var = "USUBJID_AESEQ",
          flag_variables = flag_var_aesi_label,
          table_names = "count_events_aesi",
          .stats = "count",
          .formats = c(count = "xx"),
          denom = "N_col",
          var_labels = "Medical concepts: number of adverse events which are part of",
          show_labels = "visible"
        ),
        env = list(flag_var_aesi = flag_var_aesi)
      )
    )
  }

  y$layout_anl <- substitute(
    expr = lyt_anl <- layout_anl_pipe,
    env = list(
      layout_anl_pipe = pipe_expr(layout_anl_list)
    )
  )

  y$table_anl <- pipe_expr(table_anl_list)

  table_list <- list()
  table_list <- add_expr(
    table_list,
    quote(
      rtables::col_info(result_parent) <- rtables::col_info(result_anl)
    )
  )

  all_conditions <- c(
    condition1,
    condition2,
    condition3,
    condition4,
    condition5,
    condition6
  )

  if (any(all_conditions) && (count_dth || count_wd)) {
    table_list <- add_expr(
      table_list,
      quote(
        expr = result <- rtables::rbind(
          result_anl[1:2, ],
          result_parent,
          result_anl[3:nrow(result_anl), ]
        )
      )
    )
  } else if (any(all_conditions)) {
    table_list <- add_expr(
      table_list,
      quote(
        expr = result <- rtables::rbind(
          result_anl[1:2, ],
          result_anl[3:nrow(result_anl), ]
        )
      )
    )
  } else {
    table_list <- add_expr(
      table_list,
      quote(
        result <- rtables::rbind(result_anl, result_parent)
      )
    )
  }

  y$table <- bracket_expr(table_list)

  y
}

#' teal Module: Adverse Events Summary
#'
#' This module produces an adverse events summary table.
#'
#' @inheritParams module_arguments
#' @inheritParams template_arguments
#' @inheritParams template_events_summary
#' @param arm_var ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for variable names that can be used as `arm_var`.
#'   It defines the grouping variable(s) in the results table.
#'   If there are two elements selected for `arm_var`,
#'   second variable will be nested under the first variable.
#' @param dthfl_var ([teal.transform::choices_selected()])\cr object
#'   with all available choices and preselected option for variable names that can be used as death flag variable.
#'   Records with `"Y"`` are summarized in the table row for "Total number of deaths".
#' @param dcsreas_var ([teal.transform::choices_selected()])\cr object
#'   with all available choices and preselected option for variable names that can be used as study discontinuation
#'   reason variable. Records with `"ADVERSE EVENTS"` are summarized in the table row for
#'   "Total number of patients withdrawn from study due to an AE".
#' @param flag_var_anl ([teal.transform::choices_selected()] or `NULL`)\cr
#'   vector with names of flag variables from `dataset` used to count adverse event sub-groups (e.g. Serious events,
#'   Related events, etc.). Variable labels are used as table row names if they exist.
#' @param flag_var_aesi ([teal.transform::choices_selected()] or `NULL`)\cr
#'   vector with names of flag variables from `dataset` used to count adverse event special interest groups. All flag
#'   variables must be of type `logical`. Variable labels are used as table row names if they exist.
#' @param aeseq_var ([teal.transform::choices_selected()])\cr variable for
#'   adverse events sequence number from `dataset`. Used for counting total number of events.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' library(dplyr)
#'
#' data <- teal_data()
#' data <- within(data, {
#'   ADSL <- tmc_ex_adsl %>%
#'     mutate(
#'       DTHFL = case_when(
#'         !is.na(DTHDT) ~ "Y",
#'         TRUE ~ ""
#'       ) %>% with_label("Subject Death Flag")
#'     )
#'   ADAE <- tmc_ex_adae
#'
#'   add_event_flags <- function(dat) {
#'     dat <- dat %>%
#'       mutate(
#'         TMPFL_SER = AESER == "Y",
#'         TMPFL_REL = AEREL == "Y",
#'         TMPFL_GR5 = AETOXGR == "5",
#'         TMP_SMQ01 = !is.na(SMQ01NAM),
#'         TMP_SMQ02 = !is.na(SMQ02NAM),
#'         TMP_CQ01 = !is.na(CQ01NAM)
#'       )
#'     column_labels <- list(
#'       TMPFL_SER = "Serious AE",
#'       TMPFL_REL = "Related AE",
#'       TMPFL_GR5 = "Grade 5 AE",
#'       TMP_SMQ01 = aesi_label(dat[["SMQ01NAM"]], dat[["SMQ01SC"]]),
#'       TMP_SMQ02 = aesi_label("Y.9.9.9.9/Z.9.9.9.9 AESI"),
#'       TMP_CQ01 = aesi_label(dat[["CQ01NAM"]])
#'     )
#'     col_labels(dat)[names(column_labels)] <- as.character(column_labels)
#'     dat
#'   }
#'
#'   #' Generating user-defined event flags.
#'   ADAE <- ADAE %>% add_event_flags()
#'
#'   ae_anl_vars <- names(ADAE)[startsWith(names(ADAE), "TMPFL_")]
#'   aesi_vars <- names(ADAE)[startsWith(names(ADAE), "TMP_")]
#' })
#'
#' datanames <- c("ADSL", "ADAE")
#' datanames(data) <- datanames
#' join_keys(data) <- default_cdisc_join_keys[datanames]
#'
#' app <- init(
#'   data = data,
#'   modules = modules(
#'     tm_t_events_summary(
#'       label = "Adverse Events Summary",
#'       dataname = "ADAE",
#'       arm_var = choices_selected(
#'         choices = variable_choices("ADSL", c("ARM", "ARMCD")),
#'         selected = "ARM"
#'       ),
#'       flag_var_anl = choices_selected(
#'         choices = variable_choices("ADAE", data[["ae_anl_vars"]]),
#'         selected = data[["ae_anl_vars"]][1],
#'         keep_order = TRUE,
#'         fixed = FALSE
#'       ),
#'       flag_var_aesi = choices_selected(
#'         choices = variable_choices("ADAE", data[["aesi_vars"]]),
#'         selected = data[["aesi_vars"]][1],
#'         keep_order = TRUE,
#'         fixed = FALSE
#'       ),
#'       add_total = TRUE
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_events_summary <- function(label,
                                dataname,
                                parentname = ifelse(
                                  inherits(arm_var, "data_extract_spec"),
                                  teal.transform::datanames_input(arm_var),
                                  "ADSL"
                                ),
                                arm_var,
                                flag_var_anl = NULL,
                                flag_var_aesi = NULL,
                                dthfl_var = teal.transform::choices_selected(
                                  teal.transform::variable_choices(parentname, "DTHFL"), "DTHFL",
                                  fixed = TRUE
                                ),
                                dcsreas_var = teal.transform::choices_selected(
                                  teal.transform::variable_choices(parentname, "DCSREAS"), "DCSREAS",
                                  fixed = TRUE
                                ),
                                llt = teal.transform::choices_selected(
                                  teal.transform::variable_choices(dataname, "AEDECOD"), "AEDECOD",
                                  fixed = TRUE
                                ),
                                aeseq_var = teal.transform::choices_selected(
                                  teal.transform::variable_choices(dataname, "AESEQ"), "AESEQ",
                                  fixed = TRUE
                                ),
                                add_total = TRUE,
                                total_label = default_total_label(),
                                na_level = default_na_str(),
                                count_dth = TRUE,
                                count_wd = TRUE,
                                count_subj = TRUE,
                                count_pt = TRUE,
                                count_events = TRUE,
                                pre_output = NULL,
                                post_output = NULL,
                                basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_events_summary")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(flag_var_anl, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(flag_var_aesi, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(dthfl_var, "choices_selected")
  checkmate::assert_class(dcsreas_var, "choices_selected")
  checkmate::assert_class(llt, "choices_selected")
  checkmate::assert_class(aeseq_var, "choices_selected")
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_string(na_level)
  checkmate::assert_flag(count_dth)
  checkmate::assert_flag(count_wd)
  checkmate::assert_flag(count_subj)
  checkmate::assert_flag(count_pt)
  checkmate::assert_flag(count_events)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  args <- c(as.list(environment()))

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname, multiple = TRUE, ordered = TRUE),
    dthfl_var = cs_to_des_select(dthfl_var, dataname = parentname),
    dcsreas_var = cs_to_des_select(dcsreas_var, dataname = parentname),
    flag_var_anl = `if`(
      is.null(flag_var_anl),
      NULL,
      cs_to_des_select(flag_var_anl, dataname = dataname, multiple = TRUE, ordered = TRUE)
    ),
    flag_var_aesi = `if`(
      is.null(flag_var_aesi),
      NULL,
      cs_to_des_select(flag_var_aesi, dataname = dataname, multiple = TRUE, ordered = TRUE)
    ),
    aeseq_var = cs_to_des_select(aeseq_var, dataname = dataname),
    llt = cs_to_des_select(llt, dataname = dataname)
  )

  module(
    label = label,
    ui = ui_t_events_summary,
    ui_args = c(data_extract_list, args),
    server = srv_t_events_summary,
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        total_label = total_label,
        na_level = na_level,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_t_events_summary <- function(id, ...) {
  ns <- NS(id)
  a <- list(...)

  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$arm_var,
    a$dthfl_var,
    a$dcsreas_var,
    a$flag_var_anl,
    a$flag_var_aesi,
    a$aeseq_var,
    a$llt
  )

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(
        a[c("arm_var", "dthfl_var", "dcsreas_var", "flag_var_anl", "flag_var_aesi", "aeseq_var", "llt")]
      ),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      `if`(
        is.null(a$flag_var_anl),
        NULL,
        teal.transform::data_extract_ui(
          id = ns("flag_var_anl"),
          label = "Event Flag Variables",
          data_extract_spec = a$flag_var_anl,
          is_single_dataset = is_single_dataset_value
        )
      ),
      `if`(
        is.null(a$flag_var_aesi),
        NULL,
        teal.transform::data_extract_ui(
          id = ns("flag_var_aesi"),
          label = "AE Basket Flag Variables",
          data_extract_spec = a$flag_var_aesi,
          is_single_dataset = is_single_dataset_value
        )
      ),
      checkboxInput(
        ns("add_total"),
        "Add All Patients column",
        value = a$add_total
      ),
      teal.widgets::panel_item(
        "Table Settings",
        checkboxInput(
          ns("count_dth"),
          "Count deaths",
          value = a$count_dth
        ),
        checkboxInput(
          ns("count_wd"),
          "Count withdrawals due to AE",
          value = a$count_wd
        ),
        checkboxInput(
          ns("count_subj"),
          "Count patients",
          value = a$count_subj
        ),
        checkboxInput(
          ns("count_pt"),
          "Count preferred terms",
          value = a$count_pt
        ),
        checkboxInput(
          ns("count_events"),
          "Count events",
          value = a$count_events
        )
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional Variables Info",
          teal.transform::data_extract_ui(
            id = ns("dthfl_var"),
            label = "Death Flag Variable",
            data_extract_spec = a$dthfl_var,
            is_single_dataset = is_single_dataset_value
          ),
          teal.transform::data_extract_ui(
            id = ns("dcsreas_var"),
            label = "Study Discontinuation Reason Variable",
            data_extract_spec = a$dcsreas_var,
            is_single_dataset = is_single_dataset_value
          ),
          teal.transform::data_extract_ui(
            id = ns("aeseq_var"),
            label = "AE Sequence Variable",
            data_extract_spec = a$aeseq_var,
            is_single_dataset = is_single_dataset_value
          ),
          teal.transform::data_extract_ui(
            id = ns("llt"),
            label = "AE Term Variable",
            data_extract_spec = a$llt,
            is_single_dataset = is_single_dataset_value
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_t_events_summary <- function(id,
                                 data,
                                 reporter,
                                 filter_panel_api,
                                 dataname,
                                 parentname,
                                 arm_var,
                                 dthfl_var,
                                 dcsreas_var,
                                 flag_var_anl,
                                 flag_var_aesi,
                                 aeseq_var,
                                 llt,
                                 label,
                                 total_label,
                                 na_level,
                                 basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    data_extract_vars <- list(
      arm_var = arm_var, dthfl_var = dthfl_var, dcsreas_var = dcsreas_var,
      aeseq_var = aeseq_var, llt = llt
    )

    if (!is.null(flag_var_anl)) {
      data_extract_vars[["flag_var_anl"]] <- flag_var_anl
    }

    if (!is.null(flag_var_aesi)) {
      data_extract_vars[["flag_var_aesi"]] <- flag_var_aesi
    }

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = data_extract_vars,
      datasets = data,
      select_validation_rule = list(
        arm_var = ~ if (length(.) != 1 && length(.) != 2) "Please select exactly 1 or 2 treatment variables",
        dthfl_var = shinyvalidate::sv_required("Death Flag Variable is requried"),
        dcsreas_var = shinyvalidate::sv_required("Study Discontinuation Reason Variable is required"),
        aeseq_var = shinyvalidate::sv_required("AE Sequence Variable is required"),
        llt = shinyvalidate::sv_required("AE Term Variable is required")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = Filter(Negate(is.null), list(arm_var = arm_var, dthfl_var = dthfl_var, dcsreas_var = dcsreas_var)),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    validate_checks <- reactive({
      teal::validate_inputs(iv_r())

      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]

      input_arm_var <- as.vector(merged$anl_input_r()$columns_source$arm_var)
      input_dthfl_var <- as.vector(merged$anl_input_r()$columns_source$dthfl_var)
      input_dcsreas_var <- as.vector(merged$anl_input_r()$columns_source$dcsreas_var)
      input_flag_var_anl <- if (!is.null(flag_var_anl)) {
        as.vector(merged$anl_input_r()$columns_source$flag_var_anl)
      } else {
        NULL
      }
      input_flag_var_aesi <- if (!is.null(flag_var_anl)) {
        as.vector(merged$anl_input_r()$columns_source$flag_var_aesi)
      } else {
        NULL
      }
      input_aeseq_var <- as.vector(merged$anl_input_r()$columns_source$aeseq_var)
      input_llt <- as.vector(merged$anl_input_r()$columns_source$llt)

      validate(
        need(is.factor(adsl_filtered[[input_arm_var[[1]]]]), "Treatment variable is not a factor."),
        if (length(input_arm_var) == 2) {
          need(
            is.factor(adsl_filtered[[input_arm_var[[2]]]]) && all(!adsl_filtered[[input_arm_var[[2]]]] %in% c(
              "", NA
            )),
            "Please check nested treatment variable which needs to be a factor without NA or empty strings."
          )
        }
      )

      # validate inputs
      validate_standard_inputs(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var, input_dthfl_var, input_dcsreas_var),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_flag_var_anl, input_flag_var_aesi, input_aeseq_var, input_llt),
        arm_var = input_arm_var[[1]]
      )
    })

    # The R-code corresponding to the analysis.
    table_q <- reactive({
      validate_checks()

      input_flag_var_anl <- if (!is.null(flag_var_anl)) {
        as.vector(merged$anl_input_r()$columns_source$flag_var_anl)
      } else {
        NULL
      }
      input_flag_var_aesi <- if (!is.null(flag_var_anl)) {
        as.vector(merged$anl_input_r()$columns_source$flag_var_aesi)
      } else {
        NULL
      }

      my_calls <- template_events_summary(
        anl_name = "ANL",
        parentname = "ANL_ADSL",
        arm_var = as.vector(merged$anl_input_r()$columns_source$arm_var),
        dthfl_var = as.vector(merged$anl_input_r()$columns_source$dthfl_var),
        dcsreas_var = as.vector(merged$anl_input_r()$columns_source$dcsreas_var),
        flag_var_anl = if (length(input_flag_var_anl) != 0) input_flag_var_anl else NULL,
        flag_var_aesi = if (length(input_flag_var_aesi) != 0) input_flag_var_aesi else NULL,
        aeseq_var = as.vector(merged$anl_input_r()$columns_source$aeseq_var),
        llt = as.vector(merged$anl_input_r()$columns_source$llt),
        add_total = input$add_total,
        total_label = total_label,
        na_level = na_level,
        count_dth = input$count_dth,
        count_wd = input$count_wd,
        count_subj = input$count_subj,
        count_pt = input$count_pt,
        count_events = input$count_events
      )

      all_basic_table_args <- teal.widgets::resolve_basic_table_args(user_table = basic_table_args)
      teal.code::eval_code(
        merged$anl_q(),
        as.expression(my_calls)
      ) %>%
        teal.code::eval_code(
          substitute(
            expr = {
              rtables::main_title(result) <- title
              rtables::main_footer(result) <- footer
              rtables::prov_footer(result) <- p_footer
              rtables::subtitles(result) <- subtitle
              result
            }, env = list(
              title = `if`(is.null(all_basic_table_args$title), label, all_basic_table_args$title),
              footer = `if`(is.null(all_basic_table_args$main_footer), "", all_basic_table_args$main_footer),
              p_footer = `if`(is.null(all_basic_table_args$prov_footer), "", all_basic_table_args$prov_footer),
              subtitle = `if`(is.null(all_basic_table_args$subtitles), "", all_basic_table_args$subtitles)
            )
          )
        )
    })

    # Outputs to render.
    table_r <- reactive(table_q()[["result"]])

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(table_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Adverse Events Summary Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(table_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Grade Summary Table
#'
#' Creates a valid expression to generate a grade summary table.
#'
#' @inheritParams template_arguments
#' @param anl_toxgrade_var (`character`)\cr name of the variable indicating the analysis toxicity grade.
#' @param base_toxgrade_var (`character`)\cr name of the variable indicating the baseline toxicity grade.
#' @param code_missing_baseline (`logical`)\cr whether missing baseline grades should be counted as grade 0.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_shift_by_grade()]
#'
#' @keywords internal
template_shift_by_grade <- function(parentname,
                                    dataname,
                                    arm_var = "ARM",
                                    id_var = "USUBJID",
                                    visit_var = "AVISIT",
                                    worst_flag_var = c("WGRLOVFL", "WGRLOFL", "WGRHIVFL", "WGRHIFL"),
                                    worst_flag_indicator = "Y",
                                    anl_toxgrade_var = "ATOXGR",
                                    base_toxgrade_var = "BTOXGR",
                                    paramcd = "PARAMCD",
                                    drop_arm_levels = TRUE,
                                    add_total = FALSE,
                                    total_label = default_total_label(),
                                    na_level = default_na_str(),
                                    code_missing_baseline = FALSE,
                                    basic_table_args = teal.widgets::basic_table_args()) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(arm_var)
  checkmate::assert_string(id_var)
  checkmate::assert_string(visit_var)
  checkmate::assert_string(worst_flag_indicator)
  checkmate::assert_character(worst_flag_var)
  checkmate::assert_string(anl_toxgrade_var)
  checkmate::assert_string(base_toxgrade_var)
  checkmate::assert_string(paramcd)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_string(na_level)

  worst_flag_var <- match.arg(worst_flag_var)

  y <- list()
  data_list <- list()

  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl <- df %>%
        dplyr::filter(worst_flag_var == worst_flag_indicator),
      env = list(
        df = as.name(dataname),
        worst_flag_var = as.name(worst_flag_var),
        worst_flag_indicator = worst_flag_indicator
      )
    )
  )

  data_list <- add_expr(
    data_list,
    prepare_arm_levels(
      dataname = "anl",
      parentname = parentname,
      arm_var = arm_var,
      drop_arm_levels = drop_arm_levels
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = dataname <- df_explicit_na(dataname, na_level = na_str),
      env = list(
        dataname = as.name("anl"),
        na_str = na_level
      )
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = parentname <- df_explicit_na(parentname, na_level = na_str),
      env = list(
        parentname = as.name(parentname),
        na_str = na_level
      )
    )
  )

  by_visit_fl <- dplyr::if_else(worst_flag_var %in% c("WGRLOVFL", "WGRHIVFL"), TRUE, FALSE)

  data_list <- add_expr(
    data_list,
    substitute(
      by_visit <- by_visit_fl,
      env = list(
        by_visit_fl = by_visit_fl
      )
    )
  )

  # Create new grouping variables ATOXGR_GP, BTOXGR_GP
  if (!code_missing_baseline) {
    if (worst_flag_var %in% c("WGRLOVFL", "WGRLOFL")) {
      data_list <- add_expr(
        data_list,
        substitute(
          dataname <- dplyr::mutate(dataname,
            ATOXGR_GP = factor(dplyr::case_when(
              ATOXGR %in% c(0, 1, 2, 3, 4) ~ "Not Low",
              ATOXGR == -1 ~ "1",
              ATOXGR == -2 ~ "2",
              ATOXGR == -3 ~ "3",
              ATOXGR == -4 ~ "4",
              ATOXGR == na_level ~ "Missing"
            )),
            BTOXGR_GP = factor(dplyr::case_when(
              BTOXGR %in% c(0, 1, 2, 3, 4) ~ "Not Low",
              BTOXGR == -1 ~ "1",
              BTOXGR == -2 ~ "2",
              BTOXGR == -3 ~ "3",
              BTOXGR == -4 ~ "4",
              BTOXGR == na_level ~ "Missing"
            ))
          ),
          env = list(
            dataname = as.name("anl"),
            ATOXGR = as.name(anl_toxgrade_var),
            BTOXGR = as.name(base_toxgrade_var),
            na_level = na_level
          )
        )
      )
    } else {
      data_list <- add_expr(
        data_list,
        substitute(
          dataname <- dplyr::mutate(dataname,
            ATOXGR_GP = factor(dplyr::case_when(
              ATOXGR %in% c(0, -1, -2, -3, -4) ~ "Not High",
              ATOXGR == 1 ~ "1",
              ATOXGR == 2 ~ "2",
              ATOXGR == 3 ~ "3",
              ATOXGR == 4 ~ "4",
              ATOXGR == na_level ~ "Missing"
            )),
            BTOXGR_GP = factor(dplyr::case_when(
              BTOXGR %in% c(0, -1, -2, -3, -4) ~ "Not High",
              BTOXGR == 1 ~ "1",
              BTOXGR == 2 ~ "2",
              BTOXGR == 3 ~ "3",
              BTOXGR == 4 ~ "4",
              BTOXGR == na_level ~ "Missing"
            ))
          ),
          env = list(
            dataname = as.name("anl"),
            ATOXGR = as.name(anl_toxgrade_var),
            BTOXGR = as.name(base_toxgrade_var),
            na_level = na_level
          )
        )
      )
    }
  } else {
    if (worst_flag_var %in% c("WGRLOVFL", "WGRLOFL")) {
      data_list <- add_expr(
        data_list,
        substitute(
          dataname <- dplyr::mutate(dataname,
            ATOXGR_GP = factor(dplyr::case_when(
              ATOXGR %in% c(0, 1, 2, 3, 4) ~ "Not Low",
              ATOXGR == -1 ~ "1",
              ATOXGR == -2 ~ "2",
              ATOXGR == -3 ~ "3",
              ATOXGR == -4 ~ "4",
              ATOXGR == na_level ~ "Missing"
            )),
            BTOXGR_GP = factor(dplyr::case_when(
              BTOXGR %in% c(0, 1, 2, 3, 4, na_level) ~ "Not Low",
              BTOXGR == -1 ~ "1",
              BTOXGR == -2 ~ "2",
              BTOXGR == -3 ~ "3",
              BTOXGR == -4 ~ "4"
            ))
          ),
          env = list(
            dataname = as.name("anl"),
            ATOXGR = as.name(anl_toxgrade_var),
            BTOXGR = as.name(base_toxgrade_var),
            na_level = na_level
          )
        )
      )
    } else {
      data_list <- add_expr(
        data_list,
        substitute(
          dataname <- dplyr::mutate(dataname,
            ATOXGR_GP = factor(dplyr::case_when(
              ATOXGR %in% c(0, -1, -2, -3, -4) ~ "Not High",
              ATOXGR == 1 ~ "1",
              ATOXGR == 2 ~ "2",
              ATOXGR == 3 ~ "3",
              ATOXGR == 4 ~ "4",
              ATOXGR == na_level ~ "Missing"
            )),
            BTOXGR_GP = factor(dplyr::case_when(
              BTOXGR %in% c(0, -1, -2, -3, -4, na_level) ~ "Not High",
              BTOXGR == 1 ~ "1",
              BTOXGR == 2 ~ "2",
              BTOXGR == 3 ~ "3",
              BTOXGR == 4 ~ "4"
            ))
          ),
          env = list(
            dataname = as.name("anl"),
            ATOXGR = as.name(anl_toxgrade_var),
            BTOXGR = as.name(base_toxgrade_var),
            na_level = na_level
          )
        )
      )
    }
  }

  data_list <- add_expr(
    data_list,
    substitute(
      dataname <- dplyr::mutate(
        dataname,
        ATOXGR_GP = factor(
          ATOXGR_GP,
          levels = c(
            dplyr::if_else(
              worst_flag_var %in% c("WGRLOVFL", "WGRLOFL"), "Not Low", "Not High"
            ), "1", "2", "3", "4", "Missing"
          )
        ),
        BTOXGR_GP = factor(
          BTOXGR_GP,
          levels = c(
            dplyr::if_else(worst_flag_var %in% c("WGRLOVFL", "WGRLOFL"), "Not Low", "Not High"),
            "1",
            "2",
            "3",
            "4",
            "Missing"
          )
        )
      ),
      env = list(
        dataname = as.name("anl"),
        worst_flag_var = worst_flag_var
      )
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = {
        column_labels <- list(
          PARAMCD = teal.data::col_labels(dataname, fill = FALSE)[[paramcd]],
          AVISIT = teal.data::col_labels(dataname, fill = FALSE)[[visit_var]],
          ATOXGR_GP = dplyr::if_else(by_visit_fl, "Grade at Visit", "Post-baseline Grade"),
          BTOXGR_GP = "Baseline Grade"
        )
        teal.data::col_labels(dataname)[names(column_labels)] <- as.character(column_labels)
        dataname
      },
      env = list(
        dataname = as.name("anl"),
        paramcd = paramcd,
        visit_var = visit_var,
        by_visit_fl = by_visit_fl
      )
    )
  )

  y$data <- bracket_expr(data_list)

  # layout start
  y$layout_prep <- quote(split_fun <- drop_split_levels)

  basic_table_args$title <- "Grade Summary Table"
  basic_table_args$subtitles <- paste("Worst Flag Variable:", worst_flag_var)

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(show_colcounts = TRUE)
    )
  )

  layout_list <- list()
  layout_list <- add_expr(
    layout_list,
    if (add_total) {
      substitute(
        expr = expr_basic_table_args %>%
          rtables::split_cols_by(
            var = arm_var,
            split_fun = add_overall_level(total_label, first = FALSE)
          ),
        env = list(
          arm_var = arm_var,
          total_label = total_label,
          expr_basic_table_args = parsed_basic_table_args
        )
      )
    } else {
      substitute(
        expr = expr_basic_table_args %>%
          rtables::split_cols_by(var = arm_var),
        env = list(arm_var = arm_var, expr_basic_table_args = parsed_basic_table_args)
      )
    }
  )

  split_label <- substitute(
    expr = teal.data::col_labels(dataname, fill = FALSE)[[paramcd]],
    env = list(
      dataname = as.name("anl"),
      paramcd = paramcd
    )
  )

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = rtables::split_rows_by(
        var = paramcd,
        split_fun = split_fun,
        label_pos = "topleft",
        split_label = split_label
      ),
      env = list(
        paramcd = paramcd,
        split_label = split_label
      )
    )
  )

  if (by_visit_fl) {
    split_label <- substitute(
      expr = teal.data::col_labels(dataname, fill = FALSE)[[visit_var]],
      env = list(
        dataname = as.name("anl"),
        visit_var = visit_var
      )
    )

    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = rtables::split_rows_by(
          visit_var,
          split_fun = split_fun,
          label_pos = "topleft",
          split_label = split_label
        ),
        env = list(
          visit_var = visit_var,
          split_label = split_label
        )
      )
    )
  }

  if (by_visit_fl) {
    by_var_gp <- "ATOXGR_GP"
  } else {
    by_var_gp <- "BTOXGR_GP"
  }

  split_label <- substitute(
    expr = teal.data::col_labels(dataname, fill = FALSE)[[by_var_gp]],
    env = list(
      dataname = as.name("anl"),
      by_var_gp = by_var_gp
    )
  )
  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = rtables::split_rows_by(
        var = by_var_gp,
        split_fun = split_fun,
        label_pos = "topleft",
        split_label = split_label
      ),
      env = list(
        by_var_gp = by_var_gp,
        split_label = split_label
      )
    )
  )

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = summarize_num_patients(
        var = id_var,
        .stats = c("unique_count")
      ),
      env = list(
        id_var = id_var
      )
    )
  )

  count_var <- setdiff(c("ATOXGR_GP", "BTOXGR_GP"), by_var_gp)

  if (by_visit_fl) {
    indent <- 3L
  } else {
    indent <- 2L
  }

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = count_occurrences(
        vars = count_var,
        denom = "n",
        drop = TRUE,
        .indent_mods = 4L
      ) %>%
        append_varlabels(dataname, count_var, indent = indent),
      env = list(
        count_var = count_var,
        dataname = as.name("anl"),
        indent = indent
      )
    )
  )

  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  y$table <- substitute(
    expr = {
      result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) %>%
        rtables::prune_table()
      result
    },
    env = list(parent = as.name(parentname))
  )

  y
}

#' teal Module: Grade Summary Table
#'
#' This module produces a summary table of worst grades per subject by visit and parameter.
#'
#' @inheritParams module_arguments
#' @inheritParams template_shift_by_grade
#' @param anl_toxgrade_var ([teal.transform::choices_selected()])\cr
#'   variable for analysis toxicity grade.
#' @param base_toxgrade_var ([teal.transform::choices_selected()])\cr
#'   variable for baseline toxicity grade.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' ADSL <- tmc_ex_adsl
#' ADLB <- tmc_ex_adlb
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADLB = ADLB,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADLB <- tmc_ex_adlb
#'     "
#'   ),
#'   modules = modules(
#'     tm_t_shift_by_grade(
#'       label = "Grade Laboratory Abnormality Table",
#'       dataname = "ADLB",
#'       arm_var = choices_selected(
#'         choices = variable_choices(ADSL, subset = c("ARM", "ARMCD")),
#'         selected = "ARM"
#'       ),
#'       paramcd = choices_selected(
#'         choices = value_choices(ADLB, "PARAMCD", "PARAM"),
#'         selected = "ALT"
#'       ),
#'       worst_flag_var = choices_selected(
#'         choices = variable_choices(ADLB, subset = c("WGRLOVFL", "WGRLOFL", "WGRHIVFL", "WGRHIFL")),
#'         selected = c("WGRLOVFL")
#'       ),
#'       worst_flag_indicator = choices_selected(
#'         value_choices(ADLB, "WGRLOVFL"),
#'         selected = "Y", fixed = TRUE
#'       ),
#'       anl_toxgrade_var = choices_selected(
#'         choices = variable_choices(ADLB, subset = c("ATOXGR")),
#'         selected = c("ATOXGR"),
#'         fixed = TRUE
#'       ),
#'       base_toxgrade_var = choices_selected(
#'         choices = variable_choices(ADLB, subset = c("BTOXGR")),
#'         selected = c("BTOXGR"),
#'         fixed = TRUE
#'       ),
#'       add_total = FALSE
#'     )
#'   ),
#'   filter = teal_slices(teal_slice("ADSL", "SAFFL", selected = "Y"))
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_shift_by_grade <- function(label,
                                dataname,
                                parentname = ifelse(
                                  inherits(arm_var, "data_extract_spec"),
                                  teal.transform::datanames_input(arm_var),
                                  "ADSL"
                                ),
                                arm_var,
                                visit_var = teal.transform::choices_selected(
                                  teal.transform::variable_choices(dataname, subset = "AVISIT"),
                                  selected = "AVISIT", fixed = TRUE
                                ),
                                paramcd,
                                worst_flag_var = teal.transform::choices_selected(
                                  teal.transform::variable_choices(dataname, subset = c(
                                    "WGRLOVFL", "WGRLOFL", "WGRHIVFL", "WGRHIFL"
                                  )),
                                  selected = "WGRLOVFL"
                                ),
                                worst_flag_indicator = teal.transform::choices_selected(
                                  teal.transform::value_choices(dataname, "WGRLOVFL"),
                                  selected = "Y", fixed = TRUE
                                ),
                                anl_toxgrade_var = teal.transform::choices_selected(
                                  teal.transform::variable_choices(dataname, subset = c("ATOXGR")),
                                  selected = c("ATOXGR"), fixed = TRUE
                                ),
                                base_toxgrade_var = teal.transform::choices_selected(
                                  teal.transform::variable_choices(dataname, subset = c("BTOXGR")),
                                  selected = c("BTOXGR"), fixed = TRUE
                                ),
                                id_var = teal.transform::choices_selected(
                                  teal.transform::variable_choices(dataname, subset = "USUBJID"),
                                  selected = "USUBJID", fixed = TRUE
                                ),
                                add_total = FALSE,
                                total_label = default_total_label(),
                                drop_arm_levels = TRUE,
                                pre_output = NULL,
                                post_output = NULL,
                                na_level = default_na_str(),
                                code_missing_baseline = FALSE,
                                basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_shift_by_grade")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(na_level)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(visit_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(worst_flag_var, "choices_selected")
  checkmate::assert_class(worst_flag_indicator, "choices_selected")
  checkmate::assert_class(anl_toxgrade_var, "choices_selected")
  checkmate::assert_class(base_toxgrade_var, "choices_selected")
  checkmate::assert_class(id_var, "choices_selected")
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_flag(code_missing_baseline)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  args <- as.list(environment())

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    id_var = cs_to_des_select(id_var, dataname = dataname),
    visit_var = cs_to_des_select(visit_var, dataname = dataname),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname, multiple = TRUE),
    worst_flag_var = cs_to_des_select(worst_flag_var, dataname = dataname),
    anl_toxgrade_var = cs_to_des_select(anl_toxgrade_var, dataname = dataname),
    base_toxgrade_var = cs_to_des_select(base_toxgrade_var, dataname = dataname)
  )

  module(
    label = label,
    ui = ui_t_shift_by_grade,
    server = srv_t_shift_by_grade,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        total_label = total_label,
        na_level = na_level,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_t_shift_by_grade <- function(id, ...) {
  ns <- NS(id)
  a <- list(...) # module args

  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$arm_var,
    a$id_var,
    a$visit_var,
    a$paramcd,
    a$worst_flag_var,
    a$worst_flag_indicator,
    a$anl_toxgrade_var,
    a$base_toxgrade_var
  )

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(
        a[c("arm_var", "id_var", "visit_var", "paramcd", "worst_flag_var", "anl_toxgrade_var", "base_toxgrade_var")]
      ),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      checkboxInput(ns("add_total"), "Add All Patients column", value = FALSE),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select Lab Parameter",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("worst_flag_var"),
        label = "Worst flag variable",
        data_extract_spec = a$worst_flag_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("visit_var"),
        label = "Analysis Visit",
        data_extract_spec = a$visit_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("anl_toxgrade_var"),
        label = "Analysis toxicity grade",
        data_extract_spec = a$anl_toxgrade_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("base_toxgrade_var"),
        label = "Baseline toxicity grade",
        data_extract_spec = a$base_toxgrade_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional table settings",
          checkboxInput(
            ns("drop_arm_levels"),
            label = "Drop columns not in filtered analysis dataset",
            value = a$drop_arm_levels
          ),
          checkboxInput(
            ns("code_missing_baseline"),
            label = "Code missing baseline records as grade 0",
            value = a$code_missing_baseline
          )
        )
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional Variables Info",
          teal.transform::data_extract_ui(
            id = ns("id_var"),
            label = "Subject Identifier",
            data_extract_spec = a$id_var,
            is_single_dataset = is_single_dataset_value
          ),
          teal.widgets::optionalSelectInput(
            ns("worst_flag_indicator"),
            label = "Value Indicating Worst Grade",
            choices = a$worst_flag_indicator$choices,
            selected = a$worst_flag_indicator$selected,
            multiple = FALSE,
            fixed = a$worst_flag_indicator$fixed
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_t_shift_by_grade <- function(id,
                                 data,
                                 reporter,
                                 filter_panel_api,
                                 dataname,
                                 parentname,
                                 arm_var,
                                 visit_var,
                                 paramcd,
                                 worst_flag_var,
                                 anl_toxgrade_var,
                                 base_toxgrade_var,
                                 id_var,
                                 add_total,
                                 total_label,
                                 drop_arm_levels,
                                 na_level,
                                 label,
                                 basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        arm_var = arm_var,
        visit_var = visit_var,
        id_var = id_var,
        paramcd = paramcd,
        worst_flag_var = worst_flag_var,
        anl_toxgrade_var = anl_toxgrade_var,
        base_toxgrade_var = base_toxgrade_var
      ),
      datasets = data,
      select_validation_rule = list(
        base_toxgrade_var = shinyvalidate::sv_required("A baseline toxicity grade is required"),
        anl_toxgrade_var = shinyvalidate::sv_required("An analysis toxicity grade is required"),
        visit_var = shinyvalidate::sv_required("An analysis visit is required"),
        arm_var = shinyvalidate::sv_required("A treatment variable is required"),
        worst_flag_var = shinyvalidate::sv_required("A worst treatment flag is required"),
        id_var = shinyvalidate::sv_required("A subject identifier is required.")
      ),
      filter_validation_rule = list(
        paramcd = shinyvalidate::sv_required("A laboratory parameter is required")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("worst_flag_indicator", shinyvalidate::sv_required("Please select the value indicating worst grade."))
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    validate_checks <- reactive({
      teal::validate_inputs(iv_r())
      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]

      input_arm_var <- names(merged$anl_input_r()$columns_source$arm_var)
      input_id_var <- names(merged$anl_input_r()$columns_source$id_var)
      input_visit_var <- names(merged$anl_input_r()$columns_source$visit_var)
      input_paramcd_var <- names(merged$anl_input_r()$columns_source$paramcd)
      input_paramcd <- unlist(merged$anl_input_r()$filter_info$paramcd[[1]]$selected)
      input_worst_flag_var <- names(merged$anl_input_r()$columns_source$worst_flag_var)
      input_anl_toxgrade_var <- names(merged$anl_input_r()$columns_source$anl_toxgrade_var)
      input_base_toxgrade_var <- names(merged$anl_input_r()$columns_source$base_toxgrade_var)

      # validate inputs
      validate_standard_inputs(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var),
        anl = anl_filtered,
        anlvars = c(
          "USUBJID", "STUDYID", input_visit_var, input_paramcd_var, input_worst_flag_var,
          input_anl_toxgrade_var, input_base_toxgrade_var
        ),
        arm_var = input_arm_var
      )
    })

    all_q <- reactive({
      validate_checks()

      my_calls <- template_shift_by_grade(
        parentname = "ANL_ADSL",
        dataname = "ANL",
        arm_var = names(merged$anl_input_r()$columns_source$arm_var),
        visit_var = names(merged$anl_input_r()$columns_source$visit_var),
        id_var = names(merged$anl_input_r()$columns_source$id_var),
        worst_flag_var = names(merged$anl_input_r()$columns_source$worst_flag_var),
        worst_flag_indicator = input$worst_flag_indicator,
        anl_toxgrade_var = names(merged$anl_input_r()$columns_source$anl_toxgrade_var),
        base_toxgrade_var = names(merged$anl_input_r()$columns_source$base_toxgrade_var),
        paramcd = unlist(paramcd$filter)["vars_selected"],
        drop_arm_levels = input$drop_arm_levels,
        add_total = input$add_total,
        total_label = total_label,
        na_level = na_level,
        code_missing_baseline = input$code_missing_baseline,
        basic_table_args = basic_table_args
      )

      teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
    })

    # Outputs to render.
    table_r <- reactive(all_q()[["result"]])

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    # Render R code.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Grade Summary Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Event Rates Adjusted for Patient-Years
#'
#' Creates a valid expression to generate a table of event rates adjusted for patient-years.
#'
#' @inheritParams template_arguments
#' @param events_var (`character`)\cr name of the variable for number of observed events.
#' @param label_paramcd (`character`)\cr `paramcd` variable text to use in the table title.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_events_patyear()]
#'
#' @keywords internal
template_events_patyear <- function(dataname,
                                    parentname,
                                    arm_var,
                                    events_var,
                                    label_paramcd,
                                    aval_var = "AVAL",
                                    add_total = TRUE,
                                    total_label = default_total_label(),
                                    na_level = default_na_str(),
                                    control = control_incidence_rate(),
                                    drop_arm_levels = TRUE,
                                    basic_table_args = teal.widgets::basic_table_args()) {
  checkmate::assert_character(arm_var, min.len = 1, max.len = 2)

  # initialize
  y <- list()
  # data
  data_list <- list()
  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl <- df,
      env = list(df = as.name(dataname))
    )
  )
  data_list <- add_expr(
    data_list,
    prepare_arm_levels(
      dataname = "anl",
      parentname = parentname,
      arm_var = arm_var[[1]],
      drop_arm_levels = drop_arm_levels
    )
  )
  if (length(arm_var) == 2) {
    data_list <- add_expr(
      data_list,
      prepare_arm_levels(
        dataname = "anl",
        parentname = parentname,
        arm_var = arm_var[[2]],
        drop_arm_levels = drop_arm_levels
      )
    )
  }

  data_list <- add_expr(
    data_list,
    substitute(
      expr = dataname <- df_explicit_na(dataname, na_level = na_str),
      env = list(dataname = as.name("anl"), na_str = na_level)
    )
  )
  data_list <- add_expr(
    data_list,
    substitute(
      expr = parentname <- df_explicit_na(parentname, na_level = na_str),
      env = list(parentname = as.name(parentname), na_str = na_level)
    )
  )

  y$data <- bracket_expr(data_list)

  # layout
  layout_list <- list()

  basic_title <- tools::toTitleCase(paste("Event Rates Adjusted for Patient-Years by", label_paramcd))
  basic_footer <- paste(
    "CI Method:",
    if (control$conf_type == "normal") {
      "Normal (rate)"
    } else if (control$conf_type == "normal_log") {
      "Normal (log rate)"
    } else if (control$conf_type == "exact") {
      "Exact"
    } else {
      "Byar's method"
    }
  )

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(
        show_colcounts = TRUE,
        title = basic_title,
        main_footer = basic_footer
      )
    )
  )

  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = expr_basic_table_args %>%
        rtables::split_cols_by(var = arm_var),
      env = list(arm_var = arm_var[[1]], expr_basic_table_args = parsed_basic_table_args)
    )
  )

  if (length(arm_var) == 2) {
    layout_list <- add_expr(
      layout_list,
      if (drop_arm_levels) {
        substitute(
          expr = rtables::split_cols_by(nested_col, split_fun = drop_split_levels),
          env = list(nested_col = arm_var[[2]])
        )
      } else {
        substitute(
          expr = rtables::split_cols_by(nested_col),
          env = list(nested_col = arm_var[[2]])
        )
      }
    )
  }

  if (add_total) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = rtables::add_overall_col(label = total_label),
        env = list(total_label = total_label)
      )
    )
  }
  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = estimate_incidence_rate(
        vars = aval_var,
        n_events = events_var,
        control = control_incidence_rate(
          conf_level = conf_level,
          conf_type = conf_type,
          input_time_unit = input_time_unit,
          num_pt_year = num_pt_year
        )
      ),
      env = list(
        aval_var = aval_var,
        events_var = events_var,
        conf_level = control$conf_level,
        conf_type = control$conf_type,
        input_time_unit = control$input_time_unit,
        num_pt_year = control$num_pt_year
      )
    )
  )
  y$layout <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  # table
  y$table <- substitute(
    expr = {
      result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
      result
    },
    env = list(parent = as.name(parentname))
  )

  y
}

#' teal Module: Event Rates Adjusted for Patient-Years
#'
#' This module produces a table of event rates adjusted for patient-years.
#'
#' @inheritParams module_arguments
#' @inheritParams template_events_patyear
#' @param arm_var ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for variable names that can be used as `arm_var`.
#'   It defines the grouping variable(s) in the results table.
#'   If there are two elements selected for `arm_var`,
#'   second variable will be nested under the first variable.
#' @param events_var ([teal.transform::choices_selected()])\cr object with
#'   all available choices and preselected option for the variable with all event counts.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' library(dplyr)
#'
#' ADSL <- tmc_ex_adsl
#' ADAETTE <- tmc_ex_adaette %>%
#'   filter(PARAMCD %in% c("AETTE1", "AETTE2", "AETTE3")) %>%
#'   mutate(is_event = CNSR == 0) %>%
#'   mutate(n_events = as.integer(is_event))
#'
#' # 1. Basic Example
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADAETTE = ADAETTE,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADAETTE <- tmc_ex_adaette %>%
#'         filter(PARAMCD %in% c(\"AETTE1\", \"AETTE2\", \"AETTE3\")) %>%
#'         mutate(is_event = CNSR == 0) %>%
#'         mutate(n_events = as.integer(is_event))
#'     "
#'   ),
#'   modules = modules(
#'     tm_t_events_patyear(
#'       label = "AE Rate Adjusted for Patient-Years At Risk Table",
#'       dataname = "ADAETTE",
#'       arm_var = choices_selected(
#'         choices = variable_choices(ADSL, c("ARM", "ARMCD")),
#'         selected = "ARMCD"
#'       ),
#'       add_total = TRUE,
#'       events_var = choices_selected(
#'         choices = variable_choices(ADAETTE, "n_events"),
#'         selected = "n_events",
#'         fixed = TRUE
#'       ),
#'       paramcd = choices_selected(
#'         choices = value_choices(ADAETTE, "PARAMCD", "PARAM"),
#'         selected = "AETTE1"
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' # 2. Example with table split on 2 arm_var variables
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADAETTE = ADAETTE,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADAETTE <- tmc_ex_adaette %>%
#'         filter(PARAMCD %in% c(\"AETTE1\", \"AETTE2\", \"AETTE3\")) %>%
#'         mutate(is_event = CNSR == 0) %>%
#'         mutate(n_events = as.integer(is_event))
#'     "
#'   ),
#'   modules = modules(
#'     tm_t_events_patyear(
#'       label = "AE Rate Adjusted for Patient-Years At Risk Table",
#'       dataname = "ADAETTE",
#'       arm_var = choices_selected(
#'         choices = variable_choices(ADSL, c("ARM", "ARMCD", "SEX")),
#'         selected = c("ARM", "SEX")
#'       ),
#'       add_total = TRUE,
#'       events_var = choices_selected(
#'         choices = variable_choices(ADAETTE, "n_events"),
#'         selected = "n_events",
#'         fixed = TRUE
#'       ),
#'       paramcd = choices_selected(
#'         choices = value_choices(ADAETTE, "PARAMCD", "PARAM"),
#'         selected = "AETTE1"
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_events_patyear <- function(label,
                                dataname,
                                parentname = ifelse(
                                  inherits(arm_var, "data_extract_spec"),
                                  teal.transform::datanames_input(arm_var),
                                  "ADSL"
                                ),
                                arm_var,
                                events_var,
                                paramcd,
                                aval_var = teal.transform::choices_selected(
                                  teal.transform::variable_choices(dataname, "AVAL"), "AVAL",
                                  fixed = TRUE
                                ),
                                avalu_var = teal.transform::choices_selected(
                                  teal.transform::variable_choices(dataname, "AVALU"), "AVALU",
                                  fixed = TRUE
                                ),
                                add_total = TRUE,
                                total_label = default_total_label(),
                                na_level = default_na_str(),
                                conf_level = teal.transform::choices_selected(
                                  c(0.95, 0.9, 0.8), 0.95,
                                  keep_order = TRUE
                                ),
                                drop_arm_levels = TRUE,
                                pre_output = NULL,
                                post_output = NULL,
                                basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_events_patyear")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(events_var, "choices_selected")
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(aval_var, "choices_selected")
  checkmate::assert_class(avalu_var, "choices_selected")
  checkmate::assert_class(conf_level, "choices_selected")
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_string(na_level)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  args <- c(as.list(environment()))

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname, multiple = TRUE, ordered = TRUE),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname),
    aval_var = cs_to_des_select(aval_var, dataname = dataname),
    avalu_var = cs_to_des_select(avalu_var, dataname = dataname),
    events_var = cs_to_des_select(events_var, dataname = dataname)
  )

  module(
    label = label,
    ui = ui_events_patyear,
    ui_args = c(data_extract_list, args),
    server = srv_events_patyear,
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        total_label = total_label,
        na_level = na_level,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_events_patyear <- function(id, ...) {
  ns <- NS(id)
  a <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    a$arm_var, a$paramcd, a$aval_var, a$avalu_var, a$events_var
  )

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("patyear_table"))),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c("arm_var", "paramcd", "aval_var", "avalu_var", "events_var")]),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      checkboxInput(ns("add_total"), "Add All Patients column", value = a$add_total),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select an Event Type Parameter",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("aval_var"),
        label = "Analysis Variable",
        data_extract_spec = a$aval_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("events_var"),
        label = "Event Variable",
        data_extract_spec = a$events_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("avalu_var"),
        label = "Analysis Unit Variable",
        data_extract_spec = a$avalu_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.widgets::optionalSelectInput(
        inputId = ns("conf_level"),
        label = "Confidence Level",
        a$conf_level$choices,
        a$conf_level$selected,
        multiple = FALSE,
        fixed = a$conf_level$fixed
      ),
      teal.widgets::optionalSelectInput(
        ns("conf_method"),
        "CI Method",
        choices = c("Normal (rate)", "Normal (log rate)", "Exact", "Byar's method"),
        selected = "Normal (rate)",
        multiple = FALSE,
        fixed = FALSE
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional table settings",
          checkboxInput(
            ns("drop_arm_levels"),
            label = "Drop columns not in filtered analysis dataset",
            value = a$drop_arm_levels
          ),
          teal.widgets::optionalSelectInput(
            ns("num_pt_year"),
            "Time Unit for AE Rate (in Patient-Years)",
            choices = c(0.1, 1, 10, 100, 1000),
            selected = 100,
            multiple = FALSE,
            fixed = FALSE
          ),
          selectInput(
            ns("input_time_unit"),
            "Analysis Unit",
            choices = NULL,
            selected = NULL,
            multiple = FALSE
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_events_patyear <- function(id,
                               data,
                               reporter,
                               filter_panel_api,
                               dataname,
                               parentname,
                               arm_var,
                               paramcd,
                               aval_var,
                               avalu_var,
                               events_var,
                               add_total,
                               total_label,
                               na_level,
                               drop_arm_levels,
                               label,
                               basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    observeEvent(anl_q(), {
      data_anl <- merged$anl_q()[["ANL"]]
      aval_unit_var <- merged$anl_input_r()$columns_source$avalu_var
      if (length(aval_unit_var) > 0) {
        choices <- stats::na.omit(unique(data_anl[[aval_unit_var]]))
        choices <- gsub("s$", "", tolower(choices))

        updateSelectInput(
          session,
          "input_time_unit",
          choices = choices,
          selected = choices[1]
        )
      }
    })

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        arm_var = arm_var,
        paramcd = paramcd,
        aval_var = aval_var,
        avalu_var = avalu_var,
        events_var = events_var
      ),
      datasets = data,
      select_validation_rule = list(
        arm_var = ~ if (length(.) != 1 && length(.) != 2) "Please select exactly 1 or 2 treatment variables",
        aval_var = shinyvalidate::sv_required("Analysis Variable is required"),
        events_var = shinyvalidate::sv_required("Events Variable is required")
      ),
      filter_validation_rule = list(
        paramcd = shinyvalidate::sv_required("A Event Type Parameter is required")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level"))
      iv$add_rule(
        "conf_level",
        shinyvalidate::sv_between(
          0, 1,
          inclusive = c(FALSE, FALSE),
          message_fmt = "Confidence level must be between 0 and 1"
        )
      )
      iv$add_rule("conf_method", shinyvalidate::sv_required("A CI method is required"))
      iv$add_rule("num_pt_year", shinyvalidate::sv_required("Time Unit for AE Rate is required"))
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    # Prepare the analysis environment (filter data, check data, populate envir).
    validate_checks <- reactive({
      teal::validate_inputs(iv_r())
      adsl_filtered <- merged$anl_q()[[parentname]]
      anl_filtered <- merged$anl_q()[[dataname]]

      input_arm_var <- as.vector(merged$anl_input_r()$columns_source$arm_var)
      input_aval_var <- as.vector(merged$anl_input_r()$columns_source$aval_var)
      input_avalu_var <- as.vector(merged$anl_input_r()$columns_source$avalu_var)
      input_events_var <- as.vector(merged$anl_input_r()$columns_source$events_var)
      input_paramcd <- unlist(paramcd$filter)["vars_selected"]

      # validate inputs
      validate_standard_inputs(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_paramcd, input_events_var, input_aval_var, input_avalu_var),
        arm_var = input_arm_var[[1]]
      )

      validate(
        need(
          !any(is.na(merged$anl_q()[["ANL"]][[input_events_var]])),
          "`Event Variable` for selected parameter includes NA values."
        )
      )
      NULL
    })

    # The R-code corresponding to the analysis.
    table_q <- reactive({
      validate_checks()

      ANL <- merged$anl_q()[["ANL"]]
      label_paramcd <- get_paramcd_label(ANL, paramcd)

      my_calls <- template_events_patyear(
        dataname = "ANL",
        parentname = "ANL_ADSL",
        arm_var = as.vector(merged$anl_input_r()$columns_source$arm_var),
        aval_var = as.vector(merged$anl_input_r()$columns_source$aval_var),
        events_var = as.vector(merged$anl_input_r()$columns_source$events_var),
        label_paramcd = label_paramcd,
        add_total = input$add_total,
        total_label = total_label,
        na_level = na_level,
        control = control_incidence_rate(
          conf_level = as.numeric(input$conf_level),
          conf_type = if (input$conf_method == "Normal (rate)") {
            "normal"
          } else if (input$conf_method == "Normal (log rate)") {
            "normal_log"
          } else if (input$conf_method == "Exact") {
            "exact"
          } else {
            "byar"
          },
          input_time_unit = if (input$input_time_unit %in% c("day", "week", "month", "year")) {
            input$input_time_unit
          } else {
            "year"
          },
          num_pt_year = as.numeric(input$num_pt_year)
        ),
        drop_arm_levels = input$drop_arm_levels,
        basic_table_args = basic_table_args
      )
      teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
    })

    # Outputs to render.
    table_r <- reactive({
      table_q()[["result"]]
    })

    teal.widgets::table_with_settings_srv(
      id = "patyear_table",
      table_r = table_r
    )

    # Render R code.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(table_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Event Rates Adjusted For Patient-Years Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(table_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Patient Profile Adverse Events Table and Plot
#'
#' Creates a valid expression to generate an adverse events table and [ggplot2::ggplot()] plot using ADaM datasets.
#'
#' @inheritParams template_arguments
#' @param aeterm (`character`)\cr name of the reported term for the adverse event variable.
#' @param tox_grade (`character`)\cr name of the standard toxicity grade variable.
#' @param causality (`character`)\cr name of the causality variable.
#' @param outcome (`character`)\cr name of outcome of adverse event variable.
#' @param action (`character`)\cr name of action taken with study treatment variable.
#' @param time (`character`)\cr name of study day of start of adverse event variable.
#' @param decod (`character`)\cr name of dictionary derived term variable.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_g_pp_adverse_events()]
#'
#' @keywords internal
template_adverse_events <- function(dataname = "ANL",
                                    aeterm = "AETERM",
                                    tox_grade = "AETOXGR",
                                    causality = "AEREL",
                                    outcome = "AEOUT",
                                    action = "AEACN",
                                    time = "ASTDY",
                                    decod = NULL,
                                    patient_id,
                                    font_size = 12L,
                                    ggplot2_args = teal.widgets::ggplot2_args()) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(aeterm)
  checkmate::assert_string(tox_grade)
  checkmate::assert_string(causality)
  checkmate::assert_string(outcome)
  checkmate::assert_string(action)
  checkmate::assert_string(time, null.ok = TRUE)
  checkmate::assert_string(decod, null.ok = TRUE)
  checkmate::assert_string(patient_id)
  checkmate::assert_number(font_size)

  y <- list()

  y$table <- list()
  y$chart <- list()

  table_list <- add_expr(
    list(),
    substitute(
      expr = {
        table <- dataname %>%
          dplyr::select(
            aeterm, tox_grade, causality, outcome, action, time, decod
          ) %>%
          dplyr::arrange(dplyr::desc(tox_grade)) %>%
          `colnames<-`(col_labels(dataname, fill = TRUE)[vars])

        table <- rlistings::as_listing(
          table,
          key_cols = NULL,
          default_formatting = list(all = fmt_config(align = "left"))
        )
        main_title(table) <- paste("Patient ID:", patient_id)

        table
      },
      env = list(
        dataname = as.name(dataname),
        aeterm = as.name(aeterm),
        tox_grade = as.name(tox_grade),
        causality = as.name(causality),
        outcome = as.name(outcome),
        action = as.name(action),
        time = as.name(time),
        decod = `if`(is.null(decod), NULL, as.name(decod)),
        vars = c(aeterm, tox_grade, causality, outcome, action, time, decod),
        patient_id = patient_id
      )
    )
  )

  parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args(
    teal.widgets::resolve_ggplot2_args(
      user_plot = ggplot2_args,
      module_plot = teal.widgets::ggplot2_args(
        labs = list(y = "Adverse Events", title = paste0("Patient ID: ", patient_id)),
        theme = list(
          text = substitute(ggplot2::element_text(size = font), list(font = font_size[1])),
          axis.text.y = quote(ggplot2::element_blank()),
          axis.ticks.y = quote(ggplot2::element_blank()),
          legend.position = "right",
          panel.grid.minor = quote(ggplot2::element_line(
            linewidth = 0.5,
            linetype = "dotted",
            colour = "grey"
          )),
          panel.grid.major = quote(ggplot2::element_line(
            linewidth = 0.5,
            linetype = "dotted",
            colour = "grey"
          ))
        )
      )
    )
  )

  chart_list <- add_expr(
    list(),
    substitute(
      expr = plot <- dataname %>%
        dplyr::select(aeterm, time, tox_grade, causality) %>%
        dplyr::mutate(ATOXGR = as.character(tox_grade)) %>%
        dplyr::arrange(dplyr::desc(ATOXGR)) %>%
        dplyr::mutate(ATOXGR = dplyr::case_when(
          ATOXGR == "." ~ "UNKNOWN",
          TRUE ~ ATOXGR
        )) %>%
        ggplot2::ggplot(ggplot2::aes(
          fill = ATOXGR, color = aeterm, y = aeterm, x = time
        )) +
        ggrepel::geom_label_repel(
          ggplot2::aes(label = aeterm),
          color = "black",
          hjust = "right",
          size = font_size_var[1] / 3.5,
          show.legend = FALSE
        ) +
        ggplot2::scale_fill_manual(values = c(
          "1" = "#E2264633",
          "2" = "#E2264666",
          "3" = "#E2264699",
          "4" = "#E22646CC",
          "5" = "#E22646FF",
          "UNKNOWN" = "#ACADB1FF"
        )) +
        ggplot2::scale_y_discrete(expand = ggplot2::expansion(add = 1.2)) +
        ggplot2::xlim(1, 1.2 * max(dataname[[time_var]])) +
        ggplot2::geom_point(color = "black", size = 2, shape = 24, position = ggplot2::position_nudge(y = -0.15)) +
        labs +
        themes,
      env = list(
        dataname = as.name(dataname),
        aeterm = as.name(aeterm),
        time = as.name(time),
        tox_grade = as.name(tox_grade),
        causality = as.name(causality),
        time_var = time,
        font_size_var = font_size,
        patient_id = patient_id,
        labs = parsed_ggplot2_args$labs,
        themes = parsed_ggplot2_args$theme
      )
    )
  )

  chart_list <- add_expr(
    expr_ls = chart_list,
    new_expr = quote(print(plot))
  )

  y$table <- bracket_expr(table_list)
  y$chart <- bracket_expr(chart_list)

  y
}

#' teal Module: Patient Profile Adverse Events Table and Plot
#'
#' This module produces an adverse events table and [ggplot2::ggplot()] type plot using ADaM datasets.
#'
#' @inheritParams module_arguments
#' @inheritParams template_adverse_events
#' @param aeterm ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `AETERM` variable from `dataname`.
#' @param tox_grade ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `AETOXGR` variable from `dataname`.
#' @param causality ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `AEREL` variable from `dataname`.
#' @param outcome ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `AEOUT` variable from `dataname`.
#' @param action ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `AEACN` variable from `dataname`.
#' @param time ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `ASTDY` variable from `dataname`.
#' @param decod ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `AEDECOD` variable from `dataname`.
#'
#' @inherit module_arguments return
#'
#' @examples
#' library(nestcolor)
#' library(dplyr)
#'
#' ADAE <- tmc_ex_adae
#' ADSL <- tmc_ex_adsl %>% filter(USUBJID %in% ADAE$USUBJID)
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADAE = ADAE,
#'     code = "
#'       ADAE <- tmc_ex_adae
#'       ADSL <- tmc_ex_adsl %>% filter(USUBJID %in% ADAE$USUBJID)
#'     "
#'   ),
#'   modules = modules(
#'     tm_g_pp_adverse_events(
#'       label = "Adverse Events",
#'       dataname = "ADAE",
#'       parentname = "ADSL",
#'       patient_col = "USUBJID",
#'       plot_height = c(600L, 200L, 2000L),
#'       aeterm = choices_selected(
#'         choices = variable_choices(ADAE, "AETERM"),
#'         selected = "AETERM"
#'       ),
#'       tox_grade = choices_selected(
#'         choices = variable_choices(ADAE, "AETOXGR"),
#'         selected = "AETOXGR"
#'       ),
#'       causality = choices_selected(
#'         choices = variable_choices(ADAE, "AEREL"),
#'         selected = "AEREL"
#'       ),
#'       outcome = choices_selected(
#'         choices = variable_choices(ADAE, "AEOUT"),
#'         selected = "AEOUT"
#'       ),
#'       action = choices_selected(
#'         choices = variable_choices(ADAE, "AEACN"),
#'         selected = "AEACN"
#'       ),
#'       time = choices_selected(
#'         choices = variable_choices(ADAE, "ASTDY"),
#'         selected = "ASTDY"
#'       ),
#'       decod = NULL
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_g_pp_adverse_events <- function(label,
                                   dataname = "ADAE",
                                   parentname = "ADSL",
                                   patient_col = "USUBJID",
                                   aeterm = NULL,
                                   tox_grade = NULL,
                                   causality = NULL,
                                   outcome = NULL,
                                   action = NULL,
                                   time = NULL,
                                   decod = NULL,
                                   font_size = c(12L, 12L, 25L),
                                   plot_height = c(700L, 200L, 2000L),
                                   plot_width = NULL,
                                   pre_output = NULL,
                                   post_output = NULL,
                                   ggplot2_args = teal.widgets::ggplot2_args()) {
  message("Initializing tm_g_pp_adverse_events")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(patient_col)
  checkmate::assert_class(aeterm, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(tox_grade, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(causality, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(outcome, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(action, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(time, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(decod, "choices_selected", null.ok = TRUE)
  checkmate::assert_numeric(font_size, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(font_size[1], lower = font_size[2], upper = font_size[3], .var.name = "font_size")
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(ggplot2_args, "ggplot2_args")

  args <- as.list(environment())
  data_extract_list <- list(
    aeterm = `if`(is.null(aeterm), NULL, cs_to_des_select(aeterm, dataname = dataname)),
    tox_grade = `if`(is.null(tox_grade), NULL, cs_to_des_select(tox_grade, dataname = dataname)),
    causality = `if`(is.null(causality), NULL, cs_to_des_select(causality, dataname = dataname)),
    outcome = `if`(is.null(outcome), NULL, cs_to_des_select(outcome, dataname = dataname)),
    action = `if`(is.null(action), NULL, cs_to_des_select(action, dataname = dataname)),
    time = `if`(is.null(time), NULL, cs_to_des_select(time, dataname = dataname)),
    decod = `if`(is.null(decod), NULL, cs_to_des_select(decod, dataname = dataname))
  )

  module(
    label = label,
    ui = ui_g_adverse_events,
    ui_args = c(data_extract_list, args),
    server = srv_g_adverse_events,
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        label = label,
        patient_col = patient_col,
        plot_height = plot_height,
        plot_width = plot_width,
        ggplot2_args = ggplot2_args
      )
    ),
    datanames = c(dataname, parentname)
  )
}

#' @keywords internal
ui_g_adverse_events <- function(id, ...) {
  ui_args <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    ui_args$aeterm,
    ui_args$tox_grade,
    ui_args$causality,
    ui_args$outcome,
    ui_args$action,
    ui_args$time,
    ui_args$decod
  )

  ns <- NS(id)
  teal.widgets::standard_layout(
    output = tags$div(
      htmlOutput(ns("title")),
      teal.widgets::get_dt_rows(ns("table"), ns("table_rows")),
      DT::DTOutput(outputId = ns("table")),
      teal.widgets::plot_with_settings_ui(id = ns("chart"))
    ),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(ui_args[c(
        "aeterm", "tox_grade", "causality", "outcome",
        "action", "time", "decod"
      )]),
      teal.widgets::optionalSelectInput(
        ns("patient_id"),
        "Select Patient:",
        multiple = FALSE,
        options = shinyWidgets::pickerOptions(`liveSearch` = TRUE)
      ),
      teal.transform::data_extract_ui(
        id = ns("aeterm"),
        label = "Select AETERM variable:",
        data_extract_spec = ui_args$aeterm,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("tox_grade"),
        label = "Select AETOXGR variable:",
        data_extract_spec = ui_args$tox_grade,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("causality"),
        label = "Select AEREL variable:",
        data_extract_spec = ui_args$causality,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("outcome"),
        label = "Select AEOUT variable:",
        data_extract_spec = ui_args$outcome,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("action"),
        label = "Select AEACN variable:",
        data_extract_spec = ui_args$action,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("time"),
        label = "Select ASTDY variable:",
        data_extract_spec = ui_args$time,
        is_single_dataset = is_single_dataset_value
      ),
      `if`(
        is.null(ui_args$decod),
        NULL,
        teal.transform::data_extract_ui(
          id = ns("decod"),
          label = "Select DECOD variable:",
          data_extract_spec = ui_args$decod,
          is_single_dataset = is_single_dataset_value
        )
      ),
      teal.widgets::panel_item(
        title = "Plot settings",
        collapsed = TRUE,
        teal.widgets::optionalSliderInputValMinMax(
          ns("font_size"),
          "Font Size",
          ui_args$font_size,
          ticks = FALSE, step = 1
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = ui_args$pre_output,
    post_output = ui_args$post_output
  )
}

#' @keywords internal
srv_g_adverse_events <- function(id,
                                 data,
                                 filter_panel_api,
                                 reporter,
                                 dataname,
                                 parentname,
                                 patient_col,
                                 aeterm,
                                 tox_grade,
                                 causality,
                                 outcome,
                                 action,
                                 time,
                                 decod,
                                 plot_height,
                                 plot_width,
                                 label,
                                 ggplot2_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    patient_id <- reactive(input$patient_id)

    # Init
    patient_data_base <- reactive(unique(data()[[parentname]][[patient_col]]))
    teal.widgets::updateOptionalSelectInput(
      session,
      "patient_id",
      choices = patient_data_base(),
      selected = patient_data_base()[1]
    )

    observeEvent(patient_data_base(),
      handlerExpr = {
        teal.widgets::updateOptionalSelectInput(
          session,
          "patient_id",
          choices = patient_data_base(),
          selected = if (length(patient_data_base()) == 1) {
            patient_data_base()
          } else {
            intersect(patient_id(), patient_data_base())
          }
        )
      },
      ignoreInit = TRUE
    )

    # Adverse events tab ----
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = Filter(
        Negate(is.null),
        list(
          aeterm = aeterm,
          tox_grade = tox_grade,
          causality = causality,
          outcome = outcome,
          action = action,
          time = time,
          decod = decod
        )
      ),
      datasets = data,
      select_validation_rule = list(
        aeterm = shinyvalidate::sv_required("Please select AETERM variable."),
        tox_grade = shinyvalidate::sv_required("Please select AETOXGR variable."),
        causality = shinyvalidate::sv_required("Please select AEREL variable."),
        outcome = shinyvalidate::sv_required("Please select AEOUT variable."),
        action = shinyvalidate::sv_required("Please select AEACN variable."),
        time = shinyvalidate::sv_required("Please select ASTDY variable."),
        decod = shinyvalidate::sv_required("Please select ANRIND variable.")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient"))
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list
    )

    anl_q <- reactive(
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr))
    )

    all_q <- reactive({
      teal::validate_inputs(iv_r())
      anl_m <- anl_inputs()

      ANL <- anl_q()[["ANL"]]

      teal::validate_has_data(ANL[ANL[[patient_col]] == input$patient_id, ], min_nrow = 1)

      anl_q2 <- teal.code::eval_code(
        anl_q(),
        substitute(
          expr = {
            pt_id <- patient_id
            ANL <- ANL[ANL[[patient_col]] == patient_id, ]
          }, env = list(
            patient_col = patient_col,
            patient_id = patient_id()
          )
        )
      )

      calls <- template_adverse_events(
        dataname = "ANL",
        aeterm = input[[extract_input("aeterm", dataname)]],
        tox_grade = input[[extract_input("tox_grade", dataname)]],
        causality = input[[extract_input("causality", dataname)]],
        outcome = input[[extract_input("outcome", dataname)]],
        action = input[[extract_input("action", dataname)]],
        time = input[[extract_input("time", dataname)]],
        decod = input[[extract_input("decod", dataname)]],
        patient_id = patient_id(),
        font_size = input[["font_size"]],
        ggplot2_args = ggplot2_args
      )

      teal.code::eval_code(anl_q2, as.expression(calls))
    })

    output$title <- renderText({
      paste("<h5><b>Patient ID:", all_q()[["pt_id"]], "</b></h5>")
    })

    output$table <- DT::renderDataTable(
      expr = teal.code::dev_suppress(all_q()[["table"]]),
      options = list(pageLength = input$table_rows)
    )

    plot_r <- reactive({
      req(iv_r()$is_valid())
      all_q()[["plot"]]
    })

    pws <- teal.widgets::plot_with_settings_srv(
      id = "chart",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Patient Profile Adverse Events Plot",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(teal.code::dev_suppress(all_q()[["table"]]))
        card$append_text("Plot", "header3")
        card$append_plot(plot_r(), dim = pws$dim())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Observer for Treatment reference variable
#'
#' @description `r lifecycle::badge("stable")`
#' Updates the reference and comparison Treatments when the selected Treatment variable changes
#'
#' @param session (`environment`)\cr shiny session
#' @param input (`character`)\cr shiny input
#' @param output (`character`)\cr shiny input
#' @param id_ref (`character`)\cr id of reference Treatment input UI element
#' @param id_comp (`character`)\cr id of comparison group input UI element
#' @param id_arm_var (`character`)\cr id of Treatment variable input UI element
#' @param data (`reactive` or `data.frame`)\cr dataset used to validate Treatment reference inputs and
#'   set `id_ref` input.
#' @param arm_ref_comp (`unknown`)\cr Treatment reference and compare variables provided as a
#'   nested list where each Treatment variable corresponds a list specifying the default levels for the
#'   reference and comparison treatments.
#' @param module (`character`)\cr name of the module where this is called (this is only used
#'   to produce more informative error messages)
#' @param on_off (`logical`)\cr A reactive that can be used to
#'   stop the whole observer if `FALSE`.
#' @param input_id (`character`)\cr unique id that the buckets will be referenced with.
#' @param output_id (`character`)\cr name of the UI id that the output will be written to.
#' @return Returns a `shinyvalidate::InputValidator` which checks that there is at least one reference
#'   and comparison arm
#' @keywords internal
#'
arm_ref_comp_observer <- function(session,
                                  input,
                                  output,
                                  id_ref = "Ref",
                                  id_comp = "Comp",
                                  id_arm_var,
                                  data,
                                  arm_ref_comp,
                                  module,
                                  on_off = reactive(TRUE),
                                  input_id = "buckets",
                                  output_id = "arms_buckets") {
  iv <- shinyvalidate::InputValidator$new()
  iv1 <- shinyvalidate::InputValidator$new()
  iv2 <- shinyvalidate::InputValidator$new()
  iv2$condition(~ iv1$is_valid())
  iv1$add_rule(id_arm_var, shinyvalidate::sv_required("Treatment variable must be selected"))
  iv2$add_rule(input_id, ~ if (length(.[[id_ref]]) == 0) "A reference arm must be selected")
  iv2$add_rule(input_id, ~ if (length(.[[id_comp]]) == 0) "A comparison arm must be selected")
  iv$add_validator(iv1)
  iv$add_validator(iv2)


  output[[output_id]] <- renderUI({
    if (isTRUE(on_off())) {
      df <- if (is.reactive(data)) {
        data()
      } else {
        data
      }
      check_arm_ref_comp(arm_ref_comp, df, module) ## throws an error if there are issues

      arm_var <- req(input[[id_arm_var]])

      arm <- df[[arm_var]]
      teal::validate_has_elements(arm, "Treatment variable is empty.")

      arm_levels <- if (is.factor(arm)) {
        levels(droplevels(arm))
      } else {
        unique(arm)
      }
      default_settings <- arm_ref_comp[[arm_var]]

      if (is.null(default_settings)) {
        ref_arm <- arm_levels[1]
        comp_arm <- setdiff(arm_levels, ref_arm)
      } else {
        ref_arm <- default_settings$ref
        comp_arm <- default_settings$comp
      }

      buckets <- list(ref_arm, comp_arm)
      names(buckets) <- c(id_ref, id_comp)

      teal.widgets::draggable_buckets(
        session$ns(input_id),
        label = "Groups",
        elements = character(),
        buckets = buckets
      )
    }
  })

  return(iv)
}

#' Check if the Treatment variable is reference or compare
#'
#' @description `r lifecycle::badge("stable")`
#' @param x (`character`)\cr Name of the variable
#' @param df_to_check (`data.frame`)\cr table to check
#' @param module (`character`)\cr teal module the ref and comp are called in
#'
#' @keywords internal
#'
#' @return `TRUE` or `FALSE` whether the variable is in ref or comp
check_arm_ref_comp <- function(x, df_to_check, module) {
  msg <- paste("module", module, "argument arm_ref_comp ")

  if (!is.null(x)) {
    if (!is.list(x)) {
      stop(msg, "needs to be a list or NULL")
    }

    vars <- names(x)
    if (is.null(vars) || any(vars == "")) {
      stop(msg, "is not named")
    }

    if (!all(vars %in% names(df_to_check))) {
      stop(msg, "refers to variables that are not in the data")
    }

    Map(
      x, vars,
      f = function(xi, var) {
        if (!checkmate::check_list(xi) || !setequal(names(xi), c("comp", "ref"))) {
          stop(
            msg, "definition for Treatment variable ",
            var, " list element needs to be lists with ref and comp elements"
          )
        }
      }
    )
  }

  invisible(TRUE)
}

#' Template: Patient Profile Timeline Plot
#'
#' Creates a valid expression to generate a patient profile timeline [ggplot2::ggplot()] plot using ADaM datasets.
#'
#' @inheritParams template_adverse_events
#' @inheritParams template_arguments
#' @param aetime_start (`character`)\cr name of start date/time of adverse event variable.
#' @param aetime_end (`character`)\cr name of end date/time of adverse event variable.
#' @param dstime_start (`character`)\cr name of date/time of first exposure to treatment variable.
#' @param dstime_end (`character`)\cr name of date/time of last exposure to treatment variable.
#' @param aerelday_start (`character`)\cr name of adverse event study start day variable.
#' @param aerelday_end (`character`)\cr name of adverse event study end day variable.
#' @param dsrelday_start (`character`)\cr name of concomitant medications study start day variable.
#' @param dsrelday_end (`character`)\cr name of concomitant medications study day start variable.
#' @param relative_day (`logical`)\cr whether to use relative days (`TRUE`) or absolute dates (`FALSE`).
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_g_pp_patient_timeline()]
#'
#' @keywords internal
template_patient_timeline <- function(dataname = "ANL",
                                      aeterm = "AETERM",
                                      aetime_start = "ASTDTM",
                                      aetime_end = "AENDTM",
                                      dstime_start = "CMASTDTM",
                                      dstime_end = "CMAENDTM",
                                      cmdecod = "CMDECOD",
                                      aerelday_start = NULL,
                                      aerelday_end = NULL,
                                      dsrelday_start = NULL,
                                      dsrelday_end = NULL,
                                      relative_day = FALSE,
                                      patient_id,
                                      font_size = 12L,
                                      ggplot2_args = teal.widgets::ggplot2_args()) {
  # Note: The variables used for aetime_start, aetime_end, dstime_start and dstime_end are to be
  # updated after random.cdisc.data updates.

  checkmate::assert_string(dataname)
  checkmate::assert_string(aeterm, null.ok = TRUE)
  checkmate::assert_string(aetime_start, null.ok = TRUE)
  checkmate::assert_string(aetime_end, null.ok = TRUE)
  checkmate::assert_string(dstime_start, null.ok = TRUE)
  checkmate::assert_string(dstime_end, null.ok = TRUE)
  checkmate::assert_string(cmdecod, null.ok = TRUE)
  checkmate::assert_string(aerelday_start, null.ok = TRUE)
  checkmate::assert_string(dsrelday_start, null.ok = TRUE)
  checkmate::assert_number(font_size)
  checkmate::assert_flag(relative_day)
  checkmate::assert_string(patient_id)

  chart_list <- list()
  if (!relative_day) {
    parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args(
      teal.widgets::resolve_ggplot2_args(
        user_plot = ggplot2_args,
        module_plot = teal.widgets::ggplot2_args(
          labs = list(title = paste0("Patient ID: ", patient_id), x = "Absolute Study Dates"),
          theme = list(
            plot.title = substitute(
              ggplot2::element_text(hjust = 0, size = font_size_var),
              list(font_size_var = font_size)
            ),
            axis.text = substitute(
              ggplot2::element_text(size = font_size_var, face = "bold", colour = "black"),
              list(font_size_var = font_size)
            ),
            axis.title = substitute(
              ggplot2::element_text(size = font_size_var, face = "bold", colour = "black"),
              list(font_size_var = font_size)
            ),
            text = substitute(ggplot2::element_text(size = font_size_var), list(font_size_var = font_size))
          )
        )
      )
    )

    chart_list <- add_expr(
      chart_list,
      new_expr = quote({
        posixct_origin <- "1970-01-01 00:00.00 UTC"
        med_chart <- NULL
        ae_chart <- NULL
      })
    )

    if (all(vapply(list(cmdecod, dstime_start, dstime_end), Negate(is.null), logical(1)))) {
      chart_list <- add_expr(
        chart_list,
        substitute(
          expr = {
            med_chart <- dataname %>%
              dplyr::select(dstime_start, dstime_end, cmdecod) %>%
              dplyr::distinct()

            colnames(med_chart) <- c("start", "end", "event")
            med_chart$group <- "Medication"
          },
          env = list(
            dataname = as.name(dataname),
            dstime_start = `if`(length(dstime_start), as.name(dstime_start), dstime_start),
            dstime_end = `if`(length(dstime_end), as.name(dstime_end), dstime_end),
            cmdecod = `if`(length(cmdecod), as.name(cmdecod), cmdecod)
          )
        )
      )
    }

    if (all(vapply(list(aeterm, aetime_start, aetime_end), Negate(is.null), logical(1)))) {
      chart_list <- add_expr(
        chart_list,
        substitute(
          expr = {
            ae_chart <- dataname %>%
              dplyr::select(aetime_start, aetime_end, aeterm) %>%
              dplyr::distinct()
            colnames(ae_chart) <- c("start", "end", "event")
            ae_chart$group <- "Adverse Events"
          },
          env = list(
            dataname = as.name(dataname),
            aeterm = `if`(length(aeterm), as.name(aeterm), aeterm),
            aetime_start = `if`(length(aetime_start), as.name(aetime_start), aetime_start),
            aetime_end = `if`(length(aetime_end), as.name(aetime_end), aetime_end)
          )
        )
      )
    }

    chart_list <- add_expr(
      chart_list,
      substitute(
        expr = {
          vistime_data <- dplyr::bind_rows(list(ae_chart, med_chart))
          # in some cases, dates are converted to numeric so this is a step to convert them back
          vistime_data$start <- as.POSIXct(vistime_data$start, origin = posixct_origin)
          vistime_data$end <- as.POSIXct(vistime_data$end, origin = posixct_origin)
          vistime_data <- vistime_data %>%
            dplyr::filter(stats::complete.cases(.[, c("start", "end", "event")])) %>%
            dplyr::filter(!is.na(format(.data$start))) %>%
            dplyr::filter(!is.na(format(.data$end)))

          if (nrow(vistime_data) == 0 || all(is.na(format(c(vistime_data$start, vistime_data$end))))) {
            empty_plot_label <- "Empty Plot (either due to filtering or missing values).\n Consider relaxing filters."
            df <- data.frame(
              x = 0,
              y = 0,
              label = empty_plot_label
            )
            patient_timeline_plot <- ggplot2::ggplot(
              data = df,
              ggplot2::aes(
                x = x,
                y = y,
                label = label
              )
            ) +
              ggplot2::geom_label() +
              ggplot2::theme_void()
          } else {
            patient_timeline_plot <- vistime::gg_vistime(
              vistime_data,
              col.event = "event",
              col.group = "group",
              show_labels = FALSE
            ) +
              ggrepel::geom_text_repel(
                mapping = ggplot2::aes(label = event),
                size = font_size_var / 3.5,
                color = "black",
                direction = "x",
                nudge_x = 0.5,
                segment.size = 0.1
              ) +
              ggplot2::scale_x_datetime(labels = scales::date_format("%b-%Y")) + labs + themes
          }
          patient_timeline_plot
        },
        env = list(
          font_size_var = font_size,
          labs = parsed_ggplot2_args$labs,
          themes = parsed_ggplot2_args$theme
        )
      )
    )
  } else {
    parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args(
      teal.widgets::resolve_ggplot2_args(
        user_plot = ggplot2_args,
        module_plot = teal.widgets::ggplot2_args(
          labs = list(title = paste0("Patient ID: ", patient_id), x = "Relative Study Days", y = ""),
          theme = list(
            plot.title = substitute(
              ggplot2::element_text(hjust = 0, size = font_size_var),
              list(font_size_var = font_size)
            ),
            axis.text = substitute(
              ggplot2::element_text(size = font_size_var, face = "bold", colour = "black"),
              list(font_size_var = font_size)
            ),
            axis.title = substitute(
              ggplot2::element_text(size = font_size_var, face = "bold", colour = "black"),
              list(font_size_var = font_size)
            ),
            text = substitute(ggplot2::element_text(size = font_size_var), list(font_size_var = font_size)),
            legend.position = "none"
          )
        )
      ),
      ggtheme = "classic"
    )

    chart_list <- add_expr(
      chart_list,
      new_expr = quote({
        med_chart <- NULL
        ae_chart <- NULL
      })
    )

    if (length(c(dsrelday_start, dsrelday_end, cmdecod)) == 3) {
      chart_list <- add_expr(
        chart_list,
        substitute(
          expr = {
            med_chart <- dataname %>%
              dplyr::select(dsrelday_start_var, dsrelday_end_var, cmdecod) %>%
              dplyr::distinct() %>%
              dplyr::rename(start = dsrelday_start_var, end = dsrelday_end_var, event = cmdecod) %>%
              dplyr::mutate(group = "Medication")
          },
          env = list(
            dataname = as.name(dataname),
            cmdecod = cmdecod,
            dsrelday_start_var = dsrelday_start,
            dsrelday_end_var = dsrelday_end
          )
        )
      )
    }

    if (length(c(aerelday_start, aerelday_end, aeterm)) == 3) {
      chart_list <- add_expr(
        chart_list,
        substitute(
          expr = {
            ae_chart <- dataname %>%
              dplyr::select(aerelday_start_var, aerelday_end_var, aeterm) %>%
              dplyr::distinct() %>%
              dplyr::rename(start = aerelday_start_var, end = aerelday_end_var, event = aeterm) %>%
              dplyr::mutate(group = "Adverse Events")
          },
          env = list(
            dataname = as.name(dataname),
            aeterm = aeterm,
            aerelday_start_var = aerelday_start,
            aerelday_end_var = aerelday_end
          )
        )
      )
    }

    chart_list <- add_expr(
      chart_list,
      substitute(
        expr = {
          vistime_data <- dplyr::bind_rows(list(ae_chart, med_chart))
          vistime_data <- vistime_data %>%
            dplyr::filter(stats::complete.cases(.[, c("start", "end", "event")])) %>%
            dplyr::filter(!is.na(format(.data$start))) %>%
            dplyr::filter(!is.na(format(.data$end))) %>%
            dplyr::mutate(color = make.unique(group))

          if (nrow(vistime_data) == 0 || all(is.na(format(c(vistime_data$start, vistime_data$end))))) {
            empty_plot_label <- "Empty Plot (either due to filtering or missing values).\n Consider relaxing filters."
            df <- data.frame(
              x = 0,
              y = 0,
              label = empty_plot_label
            )
            patient_timeline_plot <- ggplot2::ggplot(
              data = df,
              ggplot2::aes(
                x = x,
                y = y,
                label = label
              )
            ) +
              ggplot2::geom_label() +
              ggplot2::theme_void()
          } else {
            vistime_data$event <- factor(vistime_data$event, levels = rev(unique(vistime_data$event)))
            vistime_data$group <- factor(vistime_data$group, levels = unique(vistime_data$group))
            patient_timeline_plot <- ggplot2::ggplot(
              vistime_data,
              ggplot2::aes(x = start, y = event, xend = end, yend = event, color = color)
            ) +
              ggplot2::geom_segment(size = 4) +
              ggplot2::facet_grid(group ~ ., scales = "free", space = "free") +
              ggplot2::scale_x_continuous(breaks = scales::pretty_breaks()) +
              labs +
              ggthemes +
              themes
          }
          patient_timeline_plot
        },
        env = list(
          labs = parsed_ggplot2_args$labs,
          ggthemes = parsed_ggplot2_args$ggtheme,
          themes = parsed_ggplot2_args$theme
        )
      )
    )
  }

  chart_list
}

#' teal Module: Patient Profile Timeline Plot
#'
#' This module produces a patient profile timeline [ggplot2::ggplot()] type plot using ADaM datasets.
#'
#' @inheritParams tm_g_pp_adverse_events
#' @inheritParams module_arguments
#' @inheritParams template_patient_timeline
#' @param dataname_adcm (`character`)\cr name of `ADCM` dataset or equivalent.
#' @param dataname_adae (`character`)\cr name of `ADAE` dataset or equivalent.
#' @param aerelday_start ([teal.transform::choices_selected()])\cr object
#'   with all available choices and preselected option for the `ASTDY` variable from `dataname_adae`.
#' @param aerelday_end ([teal.transform::choices_selected()])\cr object
#'   with all available choices and preselected option for the `AENDY` variable from `dataname_adae`.
#' @param dsrelday_start ([teal.transform::choices_selected()])\cr object
#'   with all available choices and preselected option for the `ASTDY` variable from `dataname_adcm`.
#' @param dsrelday_end ([teal.transform::choices_selected()])\cr object
#'   with all available choices and preselected option for the `AENDY` variable from `dataname_adcm`.
#' @param cmdecod ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `CMDECOD` variable from `dataname_adcm`.
#' @param aetime_start ([teal.transform::choices_selected()])\cr object with
#'   all available choices and preselected option for the `ASTDTM` variable from `dataname_adae`.
#' @param aetime_end ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `AENDTM` variable from `dataname_adae`.
#' @param dstime_start ([teal.transform::choices_selected()])\cr object with
#'   all available choices and preselected option for the `CMASTDTM` variable from `dataname_adcm`.
#' @param dstime_end ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the `CMAENDTM` variable from `dataname_adcm`.
#'
#' @inherit module_arguments return
#'
#' @examples
#' library(nestcolor)
#' library(dplyr)
#'
#' data <- teal_data()
#' data <- within(data, {
#'   ADAE <- tmc_ex_adae
#'   ADSL <- tmc_ex_adsl %>% filter(USUBJID %in% ADAE$USUBJID)
#'   ADCM <- tmc_ex_adcm %>% mutate(
#'     CMSTDY = case_when(
#'       CMCAT == "medcl B" ~ 20,
#'       CMCAT == "medcl C" ~ 150,
#'       TRUE ~ 1
#'     ) %>% with_label("Study Day of Start of Medication"),
#'     CMENDY = case_when(
#'       CMCAT == "medcl B" ~ 700,
#'       CMCAT == "medcl C" ~ 1000,
#'       TRUE ~ 500
#'     ) %>% with_label("Study Day of End of Medication"),
#'     CMASTDTM = ASTDTM,
#'     CMAENDTM = AENDTM
#'   )
#' })
#'
#' adcm_keys <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4")
#' datanames(data) <- c("ADSL", "ADAE", "ADCM")
#' join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADAE", "ADCM")]
#' join_keys(data)["ADCM", "ADCM"] <- adcm_keys
#' join_keys(data)["ADAE", "ADCM"] <- c("STUDYID", "USUBJID")
#'
#' app <- init(
#'   data = data,
#'   modules = modules(
#'     tm_g_pp_patient_timeline(
#'       label = "Patient Timeline",
#'       dataname_adae = "ADAE",
#'       dataname_adcm = "ADCM",
#'       parentname = "ADSL",
#'       patient_col = "USUBJID",
#'       plot_height = c(600L, 200L, 2000L),
#'       cmdecod = choices_selected(
#'         choices = variable_choices(data[["ADCM"]], "CMDECOD"),
#'         selected = "CMDECOD",
#'       ),
#'       aeterm = choices_selected(
#'         choices = variable_choices(data[["ADAE"]], "AETERM"),
#'         selected = c("AETERM")
#'       ),
#'       aetime_start = choices_selected(
#'         choices = variable_choices(data[["ADAE"]], "ASTDTM"),
#'         selected = c("ASTDTM")
#'       ),
#'       aetime_end = choices_selected(
#'         choices = variable_choices(data[["ADAE"]], "AENDTM"),
#'         selected = c("AENDTM")
#'       ),
#'       dstime_start = choices_selected(
#'         choices = variable_choices(data[["ADCM"]], "CMASTDTM"),
#'         selected = c("CMASTDTM")
#'       ),
#'       dstime_end = choices_selected(
#'         choices = variable_choices(data[["ADCM"]], "CMAENDTM"),
#'         selected = c("CMAENDTM")
#'       ),
#'       aerelday_start = choices_selected(
#'         choices = variable_choices(data[["ADAE"]], "ASTDY"),
#'         selected = c("ASTDY")
#'       ),
#'       aerelday_end = choices_selected(
#'         choices = variable_choices(data[["ADAE"]], "AENDY"),
#'         selected = c("AENDY")
#'       ),
#'       dsrelday_start = choices_selected(
#'         choices = variable_choices(data[["ADCM"]], "ASTDY"),
#'         selected = c("ASTDY")
#'       ),
#'       dsrelday_end = choices_selected(
#'         choices = variable_choices(data[["ADCM"]], "AENDY"),
#'         selected = c("AENDY")
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_g_pp_patient_timeline <- function(label,
                                     dataname_adcm = "ADCM",
                                     dataname_adae = "ADAE",
                                     parentname = "ADSL",
                                     patient_col = "USUBJID",
                                     aeterm = NULL,
                                     cmdecod = NULL,
                                     aetime_start = NULL,
                                     aetime_end = NULL,
                                     dstime_start = NULL,
                                     dstime_end = NULL,
                                     aerelday_start = NULL,
                                     aerelday_end = NULL,
                                     dsrelday_start = NULL,
                                     dsrelday_end = NULL,
                                     font_size = c(12L, 12L, 25L),
                                     plot_height = c(700L, 200L, 2000L),
                                     plot_width = NULL,
                                     pre_output = NULL,
                                     post_output = NULL,
                                     ggplot2_args = teal.widgets::ggplot2_args()) {
  message("Initializing tm_g_pp_patient_timeline")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname_adcm)
  checkmate::assert_string(dataname_adae)
  checkmate::assert_string(parentname)
  checkmate::assert_string(patient_col)
  checkmate::assert_class(aeterm, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(cmdecod, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(aetime_start, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(aetime_end, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(dstime_start, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(dstime_end, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(aerelday_start, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(aerelday_end, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(dsrelday_start, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(dsrelday_end, "choices_selected", null.ok = TRUE)
  checkmate::assert_numeric(font_size, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(font_size[1], lower = font_size[2], upper = font_size[3], .var.name = "font_size")
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )

  xor_error_string <- function(x, y) {
    paste(
      "Assertion on `", x, "` and `", y, "` failed:",
      "Both `", x, "` and `", y, "` needs to be provided or both need to be `NULL`."
    )
  }

  if (xor(is.null(aetime_start), is.null(aetime_end))) stop(xor_error_string("aetime_start", "aetime_end"))
  if (xor(is.null(dstime_start), is.null(dstime_end))) stop(xor_error_string("dstime_start", "dstime_end"))
  if (xor(is.null(aerelday_start), is.null(aerelday_end))) stop(xor_error_string("aerelday_start", "aerelday_end"))
  if (xor(is.null(dsrelday_start), is.null(dsrelday_end))) stop(xor_error_string("dsrelday_start", "dsrelday_end"))

  if (is.null(aeterm) && is.null(cmdecod)) {
    stop("At least one of 'aeterm' or 'cmdecod' needs to be provided.")
  }
  if (!is.null(aeterm) && (is.null(aetime_start) || is.null(aerelday_start))) {
    stop("If 'aeterm' is provided, then one of 'aetime_start' and 'aerelday_start' must not be empty.")
  }
  if (!is.null(cmdecod) && (is.null(dstime_start) || is.null(dsrelday_start))) {
    stop("If 'cmdecod' is provided, then one of 'dstime_start' and 'dsrelday_start' must not be empty.")
  }

  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(ggplot2_args, "ggplot2_args")

  args <- as.list(environment())
  data_extract_list <- list(
    aeterm = `if`(is.null(aeterm), NULL, cs_to_des_select(aeterm, dataname = dataname_adae)),
    cmdecod = `if`(is.null(cmdecod), NULL, cs_to_des_select(cmdecod, dataname = dataname_adcm)),
    aetime_start = `if`(is.null(aetime_start), NULL, cs_to_des_select(aetime_start, dataname = dataname_adae)),
    aetime_end = `if`(is.null(aetime_end), NULL, cs_to_des_select(aetime_end, dataname = dataname_adae)),
    dstime_start = `if`(is.null(dstime_start), NULL, cs_to_des_select(dstime_start, dataname = dataname_adcm)),
    dstime_end = `if`(is.null(dstime_end), NULL, cs_to_des_select(dstime_end, dataname = dataname_adcm)),
    aerelday_start = `if`(is.null(aerelday_start), NULL, cs_to_des_select(aerelday_start, dataname = dataname_adae)),
    aerelday_end = `if`(is.null(aerelday_end), NULL, cs_to_des_select(aerelday_end, dataname = dataname_adae)),
    dsrelday_start = `if`(is.null(dsrelday_start), NULL, cs_to_des_select(dsrelday_start, dataname = dataname_adcm)),
    dsrelday_end = `if`(is.null(dsrelday_end), NULL, cs_to_des_select(dsrelday_end, dataname = dataname_adcm))
  )

  module(
    label = label,
    ui = ui_g_patient_timeline,
    ui_args = c(data_extract_list, args),
    server = srv_g_patient_timeline,
    server_args = c(
      data_extract_list,
      list(
        dataname_adae = dataname_adae,
        dataname_adcm = dataname_adcm,
        parentname = parentname,
        label = label,
        patient_col = patient_col,
        plot_height = plot_height,
        plot_width = plot_width,
        ggplot2_args = ggplot2_args
      )
    ),
    datanames = c(dataname_adcm, dataname_adae, parentname)
  )
}

#' @keywords internal
ui_g_patient_timeline <- function(id, ...) {
  ui_args <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(
    ui_args$aeterm,
    ui_args$cmdecod,
    ui_args$aetime_start,
    ui_args$aetime_end,
    ui_args$dstime_start,
    ui_args$dstime_end,
    ui_args$aerelday_start,
    ui_args$aerelday_end,
    ui_args$dsrelday_start,
    ui_args$dsrelday_end
  )

  ns <- NS(id)
  teal.widgets::standard_layout(
    output = teal.widgets::plot_with_settings_ui(id = ns("patient_timeline_plot")),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(
        ui_args[c(
          "aeterm", "cmdecod",
          "aetime_start", "aetime_end", "dstime_start", "dstime_end",
          "aerelday_start", "aerelday_end", "dsrelday_start", "dsrelday_end"
        )]
      ),
      teal.widgets::optionalSelectInput(
        ns("patient_id"),
        "Select Patient:",
        multiple = FALSE,
        options = shinyWidgets::pickerOptions(`liveSearch` = TRUE)
      ),
      teal.transform::data_extract_ui(
        id = ns("cmdecod"),
        label = "Select Medication standardized term variable:",
        data_extract_spec = ui_args$cmdecod,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("aeterm"),
        label = "Select AE reported term variable:",
        data_extract_spec = ui_args$aeterm,
        is_single_dataset = is_single_dataset_value
      ),
      if (!is.null(ui_args$aerelday_start) || !is.null(ui_args$dsrelday_start)) {
        tagList(
          checkboxInput(ns("relday_x_axis"), label = "Use relative days on the x-axis", value = TRUE),
          conditionalPanel(
            paste0("input.relday_x_axis == true"),
            ns = ns,
            if (!is.null(ui_args$aerelday_start)) {
              tagList(
                teal.transform::data_extract_ui(
                  id = ns("aerelday_start"),
                  label = "Select AE relative start date variable:",
                  data_extract_spec = ui_args$aerelday_start,
                  is_single_dataset = is_single_dataset_value
                ),
                teal.transform::data_extract_ui(
                  id = ns("aerelday_end"),
                  label = "Select AE relative end date variable:",
                  data_extract_spec = ui_args$aerelday_end,
                  is_single_dataset = is_single_dataset_value
                )
              )
            },
            if (!is.null(ui_args$dsrelday_start)) {
              tagList(
                teal.transform::data_extract_ui(
                  id = ns("dsrelday_start"),
                  label = "Select Medication relative start date variable:",
                  data_extract_spec = ui_args$dsrelday_start,
                  is_single_dataset = is_single_dataset_value
                ),
                teal.transform::data_extract_ui(
                  id = ns("dsrelday_end"),
                  label = "Select Medication relative end date variable:",
                  data_extract_spec = ui_args$dsrelday_end,
                  is_single_dataset = is_single_dataset_value
                )
              )
            }
          )
        )
      } else {
        shinyjs::hidden(checkboxInput(ns("relday_x_axis"), label = "", value = FALSE))
      },
      conditionalPanel(
        paste0("input.relday_x_axis == false"),
        ns = ns,
        teal.transform::data_extract_ui(
          id = ns("aetime_start"),
          label = "Select ASTDTM variable:",
          data_extract_spec = ui_args$aetime_start,
          is_single_dataset = is_single_dataset_value
        ),
        teal.transform::data_extract_ui(
          id = ns("aetime_end"),
          label = "Select AENDTM variable:",
          data_extract_spec = ui_args$aetime_end,
          is_single_dataset = is_single_dataset_value
        ),
        teal.transform::data_extract_ui(
          id = ns("dstime_start"),
          label = "Select TRTSDTM variable:",
          data_extract_spec = ui_args$dstime_start,
          is_single_dataset = is_single_dataset_value
        ),
        teal.transform::data_extract_ui(
          id = ns("dstime_end"),
          label = "Select TRTEDTM variable:",
          data_extract_spec = ui_args$dstime_end,
          is_single_dataset = is_single_dataset_value
        )
      ),
      teal.widgets::panel_item(
        title = "Plot settings",
        collapsed = TRUE,
        teal.widgets::optionalSliderInputValMinMax(
          ns("font_size"),
          "Font Size",
          ui_args$font_size,
          ticks = FALSE,
          step = 1
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = ui_args$pre_output,
    post_output = ui_args$post_output
  )
}

#' @keywords internal
srv_g_patient_timeline <- function(id,
                                   data,
                                   reporter,
                                   filter_panel_api,
                                   dataname_adae,
                                   dataname_adcm,
                                   parentname,
                                   patient_col,
                                   aeterm,
                                   cmdecod,
                                   aetime_start,
                                   aetime_end,
                                   dstime_start,
                                   dstime_end,
                                   aerelday_start,
                                   aerelday_end,
                                   dsrelday_start,
                                   dsrelday_end,
                                   plot_height,
                                   plot_width,
                                   label,
                                   ggplot2_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    patient_id <- reactive(input$patient_id)

    # Init
    patient_data_base <- reactive(unique(data()[[parentname]][[patient_col]]))
    teal.widgets::updateOptionalSelectInput(
      session,
      "patient_id",
      choices = patient_data_base(),
      selected = patient_data_base()[1]
    )

    observeEvent(patient_data_base(),
      handlerExpr = {
        teal.widgets::updateOptionalSelectInput(
          session,
          "patient_id",
          choices = patient_data_base(),
          selected = if (length(patient_data_base()) == 1) {
            patient_data_base()
          } else {
            intersect(patient_id(), patient_data_base())
          }
        )
      },
      ignoreInit = TRUE
    )

    # Patient timeline tab ----
    check_box <- reactive(input$relday_x_axis)

    check_relative <- function(main_param, return_name) {
      function(value) {
        if (length(selector_list()[[main_param]]()$select) > 0 && length(value) == 0) {
          sprintf("Please add %s", return_name)
        }
      }
    }

    rule_one_parameter <- function(other) {
      function(value) {
        if (length(value) == 0L && length(selector_list()[[other]]()$select) == 0L) {
          "At least one term variable must be selected."
        }
      }
    }

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        dsrelday_start = dsrelday_start, dsrelday_end = dsrelday_end,
        aerelday_start = aerelday_start, aerelday_end = aerelday_end,
        aeterm = aeterm, aetime_start = aetime_start,
        aetime_end = aetime_end, dstime_start = dstime_start, dstime_end = dstime_end, cmdecod = cmdecod
      ),
      datasets = data,
      select_validation_rule = list(
        # aeterm
        aeterm = rule_one_parameter("cmdecod"),
        aerelday_start = check_relative("aeterm", "AE start date."),
        aerelday_end = check_relative("aeterm", "AE end date."),
        aetime_start = check_relative("aeterm", "AE start date."),
        aetime_end = check_relative("aeterm", "AE end date."),
        # cmdecod
        cmdecod = rule_one_parameter("aeterm"),
        dsrelday_start = check_relative("cmdecod", "Medication start date."),
        dsrelday_end = check_relative("cmdecod", "Medication end date."),
        dstime_start = check_relative("cmdecod", "Medication start date."),
        dstime_end = check_relative("cmdecod", "Medication end date.")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient"))
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      datasets = data,
      selector_list = selector_list
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr))
    })

    all_q <- reactive({
      teal::validate_inputs(iv_r())

      aeterm <- input[[extract_input("aeterm", dataname_adae)]]
      aetime_start <- input[[extract_input("aetime_start", dataname_adae)]]
      aetime_end <- input[[extract_input("aetime_end", dataname_adae)]]
      dstime_start <- input[[extract_input("dstime_start", dataname_adcm)]]
      dstime_end <- input[[extract_input("dstime_end", dataname_adcm)]]
      cmdecod <- input[[extract_input("cmdecod", dataname_adcm)]]
      aerelday_start <- input[[extract_input("aerelday_start", dataname_adae)]]
      aerelday_end <- input[[extract_input("aerelday_end", dataname_adae)]]
      dsrelday_start <- input[[extract_input("dsrelday_start", dataname_adcm)]]
      dsrelday_end <- input[[extract_input("dsrelday_end", dataname_adcm)]]
      font_size <- input[["font_size"]]

      ae_chart_vars_null <- any(vapply(list(aeterm, aetime_start, aetime_end), is.null, FUN.VALUE = logical(1)))
      ds_chart_vars_null <- any(vapply(list(cmdecod, dstime_start, dstime_end), is.null, FUN.VALUE = logical(1)))

      p_timeline_data <- anl_q()[["ANL"]]
      # time variables can not be NA
      p_time_data_pat <- p_timeline_data[p_timeline_data[[patient_col]] == patient_id(), ]

      validate(
        need(
          input$relday_x_axis ||
            (
              sum(stats::complete.cases(p_time_data_pat[, c(aetime_start, aetime_end)])) > 0 ||
                sum(stats::complete.cases(p_time_data_pat[, c(dstime_start, dstime_end)])) > 0
            ),
          "Selected patient is not in dataset (either due to filtering or missing values). Consider relaxing filters."
        )
      )

      aerel_chart_vars_null <- any(vapply(list(aeterm, aerelday_start, aerelday_end), is.null, FUN.VALUE = logical(1)))
      dsrel_chart_vars_null <- any(vapply(list(cmdecod, dsrelday_start, dsrelday_end), is.null, FUN.VALUE = logical(1)))

      # These lines are needed because there is a naming conflict: ADCM and ADAE will be both pass in their ASTDY and
      # AENDY columns to data_merge_module call above.
      aerelday_start_name <- `if`(
        length(aerelday_start),
        anl_inputs()$columns_source$aerelday_start[[1]],
        aerelday_start
      )
      aerelday_end_name <- `if`(
        length(aerelday_end),
        anl_inputs()$columns_source$aerelday_end[[1]],
        aerelday_end
      )
      dsrelday_start_name <- `if`(
        length(dsrelday_start),
        anl_inputs()$columns_source$dsrelday_start[[1]],
        dsrelday_start
      )
      dsrelday_end_name <- `if`(
        length(dsrelday_end),
        anl_inputs()$columns_source$dsrelday_end[[1]],
        dsrelday_end
      )

      validate(
        need(
          !input$relday_x_axis ||
            (
              sum(stats::complete.cases(p_time_data_pat[, c(aerelday_start_name, aerelday_end_name)])) > 0 ||
                sum(stats::complete.cases(p_time_data_pat[, c(dsrelday_start_name, dsrelday_end_name)])) > 0
            ),
          "Selected patient is not in dataset (either due to filtering or missing values). Consider relaxing filters."
        )
      )

      patient_timeline_calls <- template_patient_timeline(
        dataname = "ANL",
        aeterm = aeterm,
        aetime_start = aetime_start,
        aetime_end = aetime_end,
        dstime_start = dstime_start,
        dstime_end = dstime_end,
        cmdecod = cmdecod,
        aerelday_start = aerelday_start_name,
        aerelday_end = aerelday_end_name,
        dsrelday_start = dsrelday_start_name,
        dsrelday_end = dsrelday_end_name,
        font_size = font_size,
        relative_day = input$relday_x_axis,
        patient_id = patient_id(),
        ggplot2_args = ggplot2_args
      )

      qenv <- teal.code::eval_code(
        anl_q(),
        substitute(
          expr = {
            ANL <- ANL[ANL[[patient_col]] == patient_id, ]
          }, env = list(
            patient_col = patient_col,
            patient_id = patient_id()
          )
        )
      )

      teal.code::eval_code(object = qenv, as.expression(patient_timeline_calls))
    })

    plot_r <- reactive(all_q()[["patient_timeline_plot"]])

    pws <- teal.widgets::plot_with_settings_srv(
      id = "patient_timeline_plot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Patient Profile Timeline Plot",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Plot", "header3")
        card$append_plot(plot_r(), dim = pws$dim())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Template: Multiple Events by Term
#'
#' Creates a valid expression to generate a table of multiple events by term.
#'
#' @inheritParams template_arguments
#' @param seq_var (`character`)\cr name of analysis sequence number variable. Used for counting the unique number
#'   of events.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_mult_events()]
#'
#' @keywords internal
template_mult_events <- function(dataname,
                                 parentname,
                                 arm_var,
                                 seq_var,
                                 hlt,
                                 llt,
                                 add_total = TRUE,
                                 total_label = default_total_label(),
                                 na_level = default_na_str(),
                                 event_type = "event",
                                 drop_arm_levels = TRUE,
                                 basic_table_args = teal.widgets::basic_table_args()) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(arm_var)
  checkmate::assert_string(seq_var)
  checkmate::assert_character(hlt, null.ok = TRUE)
  checkmate::assert_string(llt, null.ok = FALSE)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_string(na_level)
  checkmate::assert_string(event_type)
  checkmate::assert_flag(drop_arm_levels)

  y <- list()

  # Start data steps.
  data_list <- list()

  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl <- df,
      env = list(df = as.name(dataname))
    )
  )

  data_list <- add_expr(
    data_list,
    prepare_arm_levels(
      dataname = "anl",
      parentname = parentname,
      arm_var = arm_var,
      drop_arm_levels = drop_arm_levels
    )
  )

  if (is.null(hlt)) {
    term_vars <- c(llt)
  } else {
    term_vars <- c(hlt, llt)
  }

  data_list <- add_expr(
    data_list,
    substitute(
      expr = anl <- anl %>%
        df_explicit_na(omit_columns = setdiff(names(anl), term_vars)),
      env = list(
        term_vars = term_vars
      )
    )
  )

  data_list <- add_expr(
    data_list,
    substitute_names(
      expr = anl <- anl %>%
        dplyr::mutate(seq_var = as.factor(seq_var)),
      names = list(
        seq_var = as.name(seq_var)
      )
    )
  )

  data_list <- add_expr(
    data_list,
    substitute(
      expr = parentname <- df_explicit_na(parentname, na_level = na_str),
      env = list(parentname = as.name(parentname), na_str = na_level)
    )
  )

  y$data <- bracket_expr(data_list)

  y$layout_prep <- quote(split_fun <- drop_split_levels)

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(show_colcounts = TRUE)
    )
  )

  # Start layout steps.
  layout_list <- list()

  layout_list <- add_expr(layout_list, parsed_basic_table_args)
  layout_list <- add_expr(
    layout_list,
    substitute(
      expr = rtables::split_cols_by(var = arm_var),
      env = list(arm_var = arm_var)
    )
  )

  if (add_total) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = rtables::add_overall_col(label = total_label),
        env = list(total_label = total_label)
      )
    )
  }

  unique_label <- paste0("Total number of patients with at least one ", event_type)
  nonunique_label <- paste0("Total number of ", event_type, "s")

  layout_list <- add_expr(
    layout_list,
    substitute(
      summarize_num_patients(
        var = "USUBJID",
        count_by = seq_var,
        .stats = c("unique", "nonunique"),
        .labels = c(
          unique = unique_label,
          nonunique = nonunique_label
        )
      ),
      env = list(unique_label = unique_label, nonunique_label = nonunique_label, seq_var = seq_var)
    )
  )

  if (is.null(hlt)) {
    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = count_occurrences(vars = llt, .indent_mods = -1L) %>%
          append_varlabels(dataname, llt, indent = 0L),
        env = list(
          dataname = as.name(dataname), llt = llt
        )
      )
    )
  } else {
    lbl_lst <- list()

    for (ii in seq_along(hlt)) {
      hlt_new <- hlt[ii]

      lbl_lst <- add_expr(
        lbl_lst,
        substitute(
          expr = attr(dataname$hlt_new, which = "label"),
          env = list(
            dataname = as.name(dataname),
            hlt_new = hlt_new
          )
        )
      )

      nested <- ifelse(ii == 1, FALSE, TRUE)
      indent_mod <- ifelse(ii == 1, -1L, 0L)

      layout_list <- add_expr(
        layout_list,
        substitute(
          expr =
            rtables::split_rows_by(
              hlt,
              child_labels = "visible",
              nested = nested,
              indent_mod = indent_mod,
              split_fun = split_fun,
              label_pos = "topleft",
              split_label = teal.data::col_labels(dataname[hlt_new])
            ),
          env = list(
            hlt = hlt_new,
            nested = nested,
            indent_mod = indent_mod,
            dataname = as.name(dataname),
            hlt_new = hlt_new
          )
        )
      )
    }

    layout_list <- add_expr(
      layout_list,
      substitute(
        expr = summarize_num_patients(
          var = "USUBJID",
          count_by = seq_var,
          .stats = c("unique", "nonunique"),
          .labels = c(
            unique = unique_label,
            nonunique = nonunique_label
          )
        ) %>%
          count_occurrences(vars = llt, .indent_mods = -1L) %>%
          append_varlabels(dataname, llt, indent = indent_space),
        env = list(
          dataname = as.name(dataname), llt = llt,
          unique_label = unique_label, nonunique_label = nonunique_label,
          seq_var = seq_var,
          indent_space = length(hlt)
        )
      )
    )
  }

  lyt <- substitute(
    expr = lyt <- layout_pipe,
    env = list(layout_pipe = pipe_expr(layout_list))
  )

  y$layout <- lyt

  # Table
  y$table <- substitute(
    expr = result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent),
    env = list(
      parent = as.name(parentname)
    )
  )

  # Start sorting table
  if (is.null(hlt)) {
    pth <- c(llt)
  } else {
    pth <- c(rbind(hlt, rep("*", length(hlt))), llt)
  }

  sort_list <- list()

  sort_list <- add_expr(
    sort_list,
    substitute(
      expr = sorted_result <- result %>%
        sort_at_path(path = pth, scorefun = score_occurrences),
      env = list(pth = pth)
    )
  )

  y$table_sorted <- bracket_expr(sort_list)

  # Combine tables.
  y$final_table <- quote(
    expr = {
      result <- sorted_result
      result
    }
  )

  y
}

#' teal Module: Multiple Events by Term
#'
#' This module produces a table of multiple events by term.
#'
#' @inheritParams module_arguments
#' @inheritParams template_mult_events
#' @param seq_var ([teal.transform::choices_selected()])\cr object with
#'   all available choices and preselected option for variable names that can be used as analysis sequence number
#'   variable. Used for counting the unique number of events.
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' ADSL <- tmc_ex_adsl
#' ADCM <- tmc_ex_adcm
#' adcm_keys <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4")
#'
#' join_keys <- default_cdisc_join_keys[c("ADSL", "ADCM")]
#' join_keys["ADCM", "ADCM"] <- adcm_keys
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADCM = ADCM,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADCM <- tmc_ex_adcm
#'     ",
#'     join_keys = join_keys
#'   ),
#'   modules = modules(
#'     tm_t_mult_events(
#'       label = "Concomitant Medications by Medication Class and Preferred Name",
#'       dataname = "ADCM",
#'       arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"),
#'       seq_var = choices_selected("CMSEQ", selected = "CMSEQ", fixed = TRUE),
#'       hlt = choices_selected(
#'         choices = variable_choices(ADCM, c("ATC1", "ATC2", "ATC3", "ATC4")),
#'         selected = c("ATC1", "ATC2", "ATC3", "ATC4")
#'       ),
#'       llt = choices_selected(
#'         choices = variable_choices(ADCM, c("CMDECOD")),
#'         selected = c("CMDECOD")
#'       ),
#'       add_total = TRUE,
#'       event_type = "treatment"
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_mult_events <- function(label,
                             dataname,
                             parentname = ifelse(
                               inherits(arm_var, "data_extract_spec"),
                               teal.transform::datanames_input(arm_var),
                               "ADSL"
                             ),
                             arm_var,
                             seq_var,
                             hlt,
                             llt,
                             add_total = TRUE,
                             total_label = default_total_label(),
                             na_level = default_na_str(),
                             event_type = "event",
                             drop_arm_levels = TRUE,
                             pre_output = NULL,
                             post_output = NULL,
                             basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_mult_events")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_class(arm_var, "choices_selected")
  checkmate::assert_class(seq_var, "choices_selected")
  checkmate::assert_class(hlt, "choices_selected")
  checkmate::assert_class(llt, "choices_selected")
  checkmate::assert_string(event_type)
  checkmate::assert_flag(add_total)
  checkmate::assert_string(total_label)
  checkmate::assert_string(na_level)
  checkmate::assert_flag(drop_arm_levels)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  args <- as.list(environment())

  data_extract_list <- list(
    arm_var = cs_to_des_select(arm_var, dataname = parentname),
    seq_var = cs_to_des_select(seq_var, dataname = dataname),
    hlt = cs_to_des_select(hlt, dataname = dataname, multiple = TRUE, ordered = TRUE),
    llt = cs_to_des_select(llt, dataname = dataname)
  )

  module(
    label = label,
    ui = ui_t_mult_events_byterm,
    server = srv_t_mult_events_byterm,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        dataname = dataname,
        parentname = parentname,
        event_type = event_type,
        label = label,
        total_label = total_label,
        na_level = na_level,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_t_mult_events_byterm <- function(id, ...) {
  ns <- NS(id)
  a <- list(...)
  is_single_dataset_value <- teal.transform::is_single_dataset(a$arm_var, a$seq_var, a$hlt, a$llt)

  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(
      teal.widgets::table_with_settings_ui(ns("table"))
    ),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c("arm_var", "seq_var", "hlt", "llt")]),
      teal.transform::data_extract_ui(
        id = ns("arm_var"),
        label = "Select Treatment Variable",
        data_extract_spec = a$arm_var,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("hlt"),
        label = "Event High Level Term",
        data_extract_spec = a$hlt,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("llt"),
        label = "Event Low Level Term",
        data_extract_spec = a$llt,
        is_single_dataset = is_single_dataset_value
      ),
      checkboxInput(ns("add_total"), "Add All Patients columns", value = a$add_total),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional table settings",
          checkboxInput(
            ns("drop_arm_levels"),
            label = "Drop columns not in filtered analysis dataset",
            value = a$drop_arm_levels
          )
        )
      ),
      teal.widgets::panel_group(
        teal.widgets::panel_item(
          "Additional Variables Info",
          teal.transform::data_extract_ui(
            id = ns("seq_var"),
            label = "Analysis Sequence Number",
            data_extract_spec = a$seq_var,
            is_single_dataset = is_single_dataset_value
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_t_mult_events_byterm <- function(id,
                                     data,
                                     reporter,
                                     filter_panel_api,
                                     dataname,
                                     parentname,
                                     event_type,
                                     arm_var,
                                     seq_var,
                                     hlt,
                                     llt,
                                     drop_arm_levels,
                                     label,
                                     total_label,
                                     na_level,
                                     basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        arm_var = arm_var,
        seq_var = seq_var,
        hlt = hlt,
        llt = llt
      ),
      datasets = data,
      select_validation_rule = list(
        arm_var = shinyvalidate::sv_required("Please select a treatment variable"),
        llt = shinyvalidate::sv_required("Please select a \"LOW LEVEL TERM\" variable")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      teal.transform::compose_and_enable_validators(iv, selector_list, c("arm_var", "llt"))
    })

    anl_merge_inputs <- teal.transform::merge_expression_srv(
      id = "anl_merge",
      datasets = data,
      selector_list = selector_list,
      merge_function = "dplyr::inner_join"
    )

    adsl_merge_inputs <- teal.transform::merge_expression_module(
      id = "adsl_merge",
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_merge_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_merge_inputs()$expr))
    })

    validate_checks <- reactive({
      teal::validate_inputs(iv_r())
      adsl_filtered <- anl_q()[[parentname]]
      anl_filtered <- anl_q()[[dataname]]

      anl_m <- anl_merge_inputs()
      input_arm_var <- as.vector(anl_m$columns_source$arm_var)
      input_seq_var <- as.vector(anl_m$columns_source$seq_var)

      input_hlt <- as.vector(anl_m$columns_source$hlt)
      input_llt <- as.vector(anl_m$columns_source$llt)


      validate(
        need(is.factor(adsl_filtered[[input_arm_var]]), "Treatment variable is not a factor.")
      )
      validate(
        need(is.integer(anl_filtered[[input_seq_var]]), "Analysis sequence variable is not an integer.")
      )

      # validate inputs
      validate_standard_inputs(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_seq_var, input_hlt, input_llt),
        arm_var = input_arm_var
      )
    })

    # The R-code corresponding to the analysis.
    all_q <- reactive({
      validate_checks()

      anl_q <- anl_q()
      anl_m <- anl_merge_inputs()

      input_hlt <- names(anl_m$columns_source$hlt)
      input_llt <- names(anl_m$columns_source$llt)

      hlt_labels <- mapply(function(x) rtables::obj_label(anl_q[["ANL"]][[x]]), input_hlt)
      llt_labels <- mapply(function(x) rtables::obj_label(anl_q[["ANL"]][[x]]), input_llt)

      basic_table_args$title <- ifelse(
        is.null(basic_table_args$title),
        paste(
          "Concomitant Medications by",
          paste(hlt_labels, collapse = ", "),
          "and",
          paste(llt_labels, collapse = ", ")
        ),
        basic_table_args$title
      )

      my_calls <- template_mult_events(
        dataname = "ANL",
        parentname = "ANL_ADSL",
        arm_var = names(anl_m$columns_source$arm_var),
        seq_var = names(anl_m$columns_source$seq_var),
        hlt = if (length(input_hlt) != 0) input_hlt else NULL,
        llt = input_llt,
        add_total = input$add_total,
        total_label = total_label,
        na_level = na_level,
        event_type = event_type,
        drop_arm_levels = input$drop_arm_levels,
        basic_table_args = basic_table_args
      )
      teal.code::eval_code(anl_q, as.expression(my_calls))
    })

    # Outputs to render.
    table_r <- reactive(all_q()[["result"]])

    teal.widgets::table_with_settings_srv(id = "table", table_r = table_r)

    # Render R code.
    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Multiple Events by Term Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Concatenate expressions via a binary operator
#'
#' e.g. combine with `+` for `ggplot` without introducing parentheses due to associativity
#'
#' @param args arguments to concatenate with operator
#' @param bin_op binary operator to concatenate it with
#'
#' @return a `call`
#'
#' @examples
#' library(ggplot2)
#'
#' # What we want to achieve
#' call("+", quote(f), quote(g))
#' call("+", quote(f), call("+", quote(g), quote(h))) # parentheses not wanted
#' call("+", call("+", quote(f), quote(g)), quote(h)) # as expected without unnecessary parentheses
#' Reduce(function(existing, new) call("+", existing, new), list(quote(f), quote(g), quote(h)))
#'
#' # how we do it
#' call_concatenate(list(quote(f), quote(g), quote(h)))
#' call_concatenate(list(quote(f)))
#' call_concatenate(list())
#' call_concatenate(
#'   list(quote(ggplot(mtcars)), quote(geom_point(aes(wt, mpg))))
#' )
#'
#' eval(
#'   call_concatenate(
#'     list(quote(ggplot(mtcars)), quote(geom_point(aes(wt, mpg))))
#'   )
#' )
#'
#' @export
call_concatenate <- function(args, bin_op = "+") {
  checkmate::assert_string(bin_op)
  checkmate::assert_list(args, types = c("symbol", "name", "call", "expression"))

  # can be used for dplyr and ggplot2 to concatenate calls with +
  Reduce(function(existing, new) call(bin_op, existing, new), args)
}

# needs columns like n_, n_ARM etc. to get count from
count_str_to_column_expr <- function(column, n_column = get_n_name(groupby_vars = column)) {
  checkmate::assert_string(column)

  substitute_names(
    expr = counts <- counts %>% dplyr::mutate(
      column_name = paste0(column_name, " (n = ", n_column_name, ")")
    ),
    names = list(column_name = as.symbol(column), n_column_name = as.symbol(n_column))
  )
}

#' Get variable labels
#'
#' @description `r lifecycle::badge("deprecated")`
#' @param datasets (`teal::FilteredData`)\cr Data built up by teal
#' @param dataname (`character`)\cr name of the dataset
#' @param vars (`character`)\cr Column names in the data
#'
#' @return `character` variable labels.
#'
#' @export
get_var_labels <- function(datasets, dataname, vars) {
  lifecycle::deprecate_warn(
    when = "0.8.14",
    what = "get_var_labels()",
    with = "teal.data::col_labels()",
    details = "teal.modules.clinical won't export any utility functions except those which
      are necessary to prepare shiny app."
  )
  labels <- datasets$get_varlabels(dataname, vars)
  labels <- vapply(vars, function(x) ifelse(is.na(labels[[x]]), x, labels[[x]]), character(1))
  return(labels)
}

#' Expression Deparsing
#'
#' Deparse an expression into a `string`.
#'
#' @param expr (`call`)\cr or an object which can be used as so.
#'
#' @return a `string`.
#'
#' @export
#' @examples
#' expr <- quote({
#'   library(rtables)
#'   basic_table() %>%
#'     split_cols_by(var = "ARMCD") %>%
#'     test_proportion_diff(
#'       vars = "rsp", method = "cmh", variables = list(strata = "strata")
#'     ) %>%
#'     build_table(df = dta)
#' })
#'
#' h_concat_expr(expr)
h_concat_expr <- function(expr) {
  expr <- deparse(expr)
  paste(expr, collapse = "\n")
}


#' Expressions as a Pipeline
#'
#' Concatenate expressions in a single pipeline-flavor expression.
#'
#' @param exprs (`list` of `call`)\cr expressions to concatenate in a
#'   pipeline (`%>%`).
#' @param pipe_str (`character`)\cr the character which separates the expressions.
#'
#' @return a `call`
#'
#' @examples
#' pipe_expr(
#'   list(
#'     expr1 = substitute(df),
#'     expr2 = substitute(head)
#'   )
#' )
#'
#' @export
pipe_expr <- function(exprs, pipe_str = "%>%") {
  exprs <- lapply(exprs, h_concat_expr)
  exprs <- unlist(exprs)
  exprs <- paste(exprs, collapse = pipe_str)
  str2lang(exprs)
}

#' Expression List
#'
#' Add a new expression to a list (of expressions).
#'
#' @param expr_ls (`list` of `call`)\cr the list to which a new expression
#'   should be added.
#' @param new_expr (`call`)\cr the new expression to add.
#'
#' @return a `list` of `call`.
#'
#' @details Offers a stricter control to add new expressions to an existing
#'   list. The list of expressions can be later used to generate a pipeline,
#'   for instance with `pipe_expr`.
#'
#' @export
#'
#' @examples
#' library(rtables)
#'
#' lyt <- list()
#' lyt <- add_expr(lyt, substitute(basic_table()))
#' lyt <- add_expr(
#'   lyt, substitute(split_cols_by(var = arm), env = list(armcd = "ARMCD"))
#' )
#' lyt <- add_expr(
#'   lyt,
#'   substitute(
#'     test_proportion_diff(
#'       vars = "rsp", method = "cmh", variables = list(strata = "strata")
#'     )
#'   )
#' )
#' lyt <- add_expr(lyt, quote(build_table(df = dta)))
#' pipe_expr(lyt)
add_expr <- function(expr_ls, new_expr) {
  checkmate::assert_list(expr_ls)
  checkmate::assert(is.call(new_expr) || is.name(new_expr))

  # support nested expressions such as expr({a <- 1; b <- 2})
  if (inherits(new_expr, "{")) {
    res <- expr_ls
    for (idx in seq_along(new_expr)[-1]) {
      res <- add_expr(res, new_expr[[idx]])
    }
    return(res)
  }

  c(
    expr_ls,
    list(new_expr)
  )
}


#' Expressions in Brackets
#'
#' Groups several expressions in a single _bracketed_ expression.
#'
#' @param exprs (`list` of `call`)\cr expressions to concatenate into
#'   a single _bracketed_ expression.
#'
#' @return a `{` object. See [base::Paren()] for details.
#'
#' @examples
#' adsl <- tmc_ex_adsl
#' adrs <- tmc_ex_adrs
#'
#' expr1 <- substitute(
#'   expr = anl <- subset(df, PARAMCD == param),
#'   env = list(df = as.name("adrs"), param = "INVET")
#' )
#' expr2 <- substitute(expr = anl$rsp_lab <- d_onco_rsp_label(anl$AVALC))
#' expr3 <- substitute(
#'   expr = {
#'     anl$is_rsp <- anl$rsp_lab %in%
#'       c("Complete Response (CR)", "Partial Response (PR)")
#'   }
#' )
#'
#' res <- bracket_expr(list(expr1, expr2, expr3))
#' eval(res)
#' table(anl$rsp_lab, anl$is_rsp)
#'
#' @export
bracket_expr <- function(exprs) {
  expr <- lapply(exprs, deparse)

  # Because `deparse` returns a vector accounting for line break attempted
  # for string longer than max `width.cutoff = 500`.
  expr <- lapply(expr, paste, collapse = "\n")

  expr <- paste(
    c(
      "{",
      unlist(expr),
      "}"
    ),
    collapse = "\n"
  )
  expr <- parse(text = expr, keep.source = FALSE)
  expr <- as.call(expr)[[1]]
  attributes(expr) <- NULL
  expr
}

#' Convert choices_selected to select_spec
#'
#' @param cs (`choices_selected`)\cr object to be transformed. See [teal.transform::choices_selected()] for details.
#' @param multiple (`logical`)\cr Whether multiple values shall be allowed in the
#'  shiny [shiny::selectInput()].
#' @param ordered (`logical(1)`)\cr Flags whether selection order should be tracked.
#' @param label (`character`)\cr Label to print over the selection field. For no label, set to `NULL`.
#' @export
#' @return (`select_spec`)
cs_to_select_spec <- function(cs, multiple = FALSE, ordered = FALSE, label = "Select") {
  checkmate::assert_class(cs, "choices_selected")
  checkmate::assert_flag(multiple)
  checkmate::assert_flag(ordered)

  teal.transform::select_spec(
    choices = cs$choices,
    selected = cs$selected,
    fixed = cs$fixed,
    multiple = multiple,
    ordered = ordered,
    label = label
  )
}

#' Convert choices_selected to filter_spec
#'
#' @inheritParams cs_to_select_spec
#'
#' @export
#' @return ([teal.transform::filter_spec()])
cs_to_filter_spec <- function(cs, multiple = FALSE, label = "Filter by") {
  checkmate::assert_class(cs, "choices_selected")
  checkmate::assert_flag(multiple)

  vars <- if (inherits(cs, "delayed_choices_selected")) {
    cs$choices$var_choices
  } else {
    attr(cs$choices, "var_choices")
  }

  teal.transform::filter_spec(
    vars = vars,
    choices = cs$choices,
    selected = cs$selected,
    multiple = multiple,
    drop_keys = FALSE,
    label = label
  )
}

#' Convert choices_selected to data_extract_spec with only select_spec
#'
#' @inheritParams cs_to_select_spec
#' @param dataname (`character`)\cr name of the data
#'
#' @export
#' @return ([teal.transform::data_extract_spec()])
cs_to_des_select <- function(cs, dataname, multiple = FALSE, ordered = FALSE, label = "Select") {
  cs_sub <- substitute(cs)
  cs_name <- if (is.symbol(cs_sub)) as.character(cs_sub) else "cs"

  checkmate::assert_string(dataname)
  checkmate::assert_flag(multiple)
  checkmate::assert(
    checkmate::check_class(cs, classes = "data_extract_spec"),
    checkmate::check_class(cs, classes = "choices_selected"),
    .var.name = cs_name
  )
  if (!multiple && length(cs$selected) != 1 && !is.null(cs$selected)) {
    stop(cs_name, "must only have 1 selected value")
  }

  if (inherits(cs, "choices_selected")) {
    teal.transform::data_extract_spec(
      dataname = dataname,
      select = cs_to_select_spec(cs, multiple = multiple, ordered = ordered, label = label)
    )
  } else {
    return(cs)
  }
}

#' Convert choices_selected to data_extract_spec with only filter_spec
#'
#' @inheritParams cs_to_des_select
#' @param include_vars (`flag`)\cr whether to include the filter variables as fixed selection
#'   in the result. This can be useful for preserving for reuse in `rtables` code e.g.
#'
#' @export
#' @return ([teal.transform::data_extract_spec()])
cs_to_des_filter <- function(cs, dataname, multiple = FALSE, include_vars = FALSE, label = "Filter by") {
  cs_sub <- substitute(cs)
  cs_name <- if (is.symbol(cs_sub)) as.character(cs_sub) else "cs"

  checkmate::assert_string(dataname)
  checkmate::assert_flag(multiple)
  checkmate::assert(
    checkmate::check_class(cs, classes = "data_extract_spec"),
    checkmate::check_class(cs, classes = "choices_selected"),
    .var.name = cs_name
  )
  if (!multiple && length(cs$selected) != 1 && !is.null(cs$selected)) {
    stop(cs_name, "must only have 1 selected value")
  }

  if (inherits(cs, "choices_selected")) {
    vars <- if (inherits(cs, "delayed_choices_selected")) {
      cs$choices$var_choices
    } else {
      attr(cs$choices, "var_choices")
    }
    select <- if (include_vars) {
      teal.transform::select_spec(
        choices = vars,
        selected = vars,
        fixed = TRUE
      )
    } else {
      NULL
    }

    teal.transform::data_extract_spec(
      dataname = dataname,
      filter = cs_to_filter_spec(cs, multiple = multiple, label = label),
      select = select
    )
  } else {
    return(cs)
  }
}

#' Whether object is of class [teal.transform::choices_selected()]
#'
#' @param x object to be checked
#'
#' @export
#' @return (`logical`)
is.cs_or_des <- function(x) { # nolint: object_name.
  inherits(x, c("data_extract_spec", "choices_selected"))
}

#' Split-Column Expression
#'
#' Renders the expression for column split in `rtables` depending on:
#' - the expected or not arm comparison
#' - the expected or not arm combination
#'
#' @param compare (`logical`)\cr if `TRUE` the reference level is included.
#' @param combine (`logical`)\cr if `TRUE` the group combination is included.
#' @param ref (`character`)\cr the reference level (not used for `combine = TRUE`).
#' @param arm_var (`character`)\cr the arm or grouping variable name.
#'
#' @return a `call`
#'
#' @examples
#' split_col_expr(
#'   compare = TRUE,
#'   combine = FALSE,
#'   ref = "ARM A",
#'   arm_var = "ARMCD"
#' )
#'
#' @export
split_col_expr <- function(compare, combine, ref, arm_var) {
  if (compare && combine) {
    substitute(
      expr = split_cols_by_groups(
        var = arm_var,
        groups_list = groups,
        ref_group = names(groups)[1]
      ),
      env = list(
        arm_var = arm_var
      )
    )
  } else if (compare && !combine) {
    substitute(
      expr = rtables::split_cols_by(
        var = arm_var,
        ref_group = ref
      ),
      env = list(
        arm_var = arm_var,
        ref = ref
      )
    )
  } else if (!compare) {
    substitute(
      expr = rtables::split_cols_by(var = arm_var),
      env = list(arm_var = arm_var)
    )
  }
}

#' Split `choices_selected` objects with interactions into
#' their component variables
#'
#' @param x (`choices_selected`)\cr
#'   object with interaction terms
#'
#' @note uses the regex `\\*|:` to perform the split.
#'
#' @return  a [choices_selected()] object.
#'
#' @examples
#' split_choices(choices_selected(choices = c("x:y", "a*b"), selected = all_choices()))
#'
#' @export
split_choices <- function(x) {
  checkmate::assert_class(x, "choices_selected")
  checkmate::assert_character(x$choices, min.len = 1)

  split_x <- x
  split_x$choices <- split_interactions(x$choices)
  if (!is.null(x$selected)) {
    split_x$selected <- split_interactions(x$selected)
  }

  return(split_x)
}

#' Extracts html id for `data_extract_ui`
#'
#' The `data_extract_ui` is located under extended html id. We could not use `ns("original id")`
#' for reference, as it is extended with specific suffixes.
#'
#' @param varname (`character`)\cr
#'   the original html id.  This should be retrieved with `ns("original id")` in the UI function
#'   or `session$ns("original id")`/"original id" in the server function.
#' @param dataname (`character`)\cr
#'   `dataname` from data_extract input.
#'   This might be retrieved like `data_extract_spec(...)[[1]]$dataname`.
#' @param filter (`logical`) optional,\cr
#'   if the connected `extract_data_spec` has objects passed to its `filter` argument
#'
#' @return a string
#'
#' @examples
#' extract_input("ARM", "ADSL")
#'
#' @export
extract_input <- function(varname, dataname, filter = FALSE) {
  if (filter) {
    paste0(varname, "-dataset_", dataname, "_singleextract-filter1-vals")
  } else {
    paste0(varname, "-dataset_", dataname, "_singleextract-select")
  }
}

#' Split interaction terms into their component variables
#'
#' @param x (`character`)\cr
#'  string representing the interaction
#'  usually in the form `x:y` or `x*y`.
#' @param by (`character`)\cr
#'  regex with which to split the interaction
#'  term by.
#'
#' @return a vector of strings where each element is a component
#'   variable extracted from interaction term `x`.
#'
#' @examples
#' split_interactions("x:y")
#' split_interactions("x*y")
#'
#' @export
split_interactions <- function(x, by = "\\*|:") {
  if (length(x) >= 1) {
    unique(unlist(strsplit(x, split = by)))
  } else {
    NULL
  }
}


#' Expression: Arm Preparation
#'
#' The function generate the standard expression for pre-processing of dataset
#' in teal module applications. This is especially of interest when the same
#' preprocessing steps needs to be applied similarly to several datasets
#' (e.g. `ADSL` and `ADRS`).
#'
#' @details
#' In `teal.modules.clinical`, the user interface includes manipulation of
#' the study arms. Classically: the arm variable itself (e.g. `ARM`, `ACTARM`),
#' the reference arm (0 or more), the comparison arm (1 or more) and the
#' possibility to combine comparison arms.
#'
#' Note that when no arms should be compared with each other, then the produced
#' expression is reduced to optionally dropping non-represented levels of the arm.
#'
#' When comparing arms, the pre-processing includes three steps:
#' 1. Filtering of the dataset to retain only the arms of interest (reference
#' and comparison).
#' 2. Optional, if more than one arm is designated as _reference_ they are
#' combined into a single level.
#' 3. The reference is explicitly reassigned and the non-represented levels of
#' arm are dropped.
#'
#' @inheritParams template_arguments
#' @param ref_arm_val (`character`)\cr replacement name for the reference level.
#' @param drop (`logical`)\cr drop the unused variable levels.
#'
#' @return a `call`
#'
#' @examples
#' prepare_arm(
#'   dataname = "adrs",
#'   arm_var = "ARMCD",
#'   ref_arm = "ARM A",
#'   comp_arm = c("ARM B", "ARM C")
#' )
#'
#' prepare_arm(
#'   dataname = "adsl",
#'   arm_var = "ARMCD",
#'   ref_arm = c("ARM B", "ARM C"),
#'   comp_arm = "ARM A"
#' )
#'
#' @export
prepare_arm <- function(dataname,
                        arm_var,
                        ref_arm,
                        comp_arm,
                        compare_arm = !is.null(ref_arm),
                        ref_arm_val = paste(ref_arm, collapse = "/"),
                        drop = TRUE) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(arm_var)
  checkmate::assert_character(ref_arm, null.ok = TRUE)
  checkmate::assert_character(comp_arm, null.ok = TRUE)
  checkmate::assert_flag(compare_arm)
  checkmate::assert_string(ref_arm_val)
  checkmate::assert_flag(drop)

  data_list <- list()

  if (compare_arm) {
    # Data are filtered to keep only arms of interest.
    data_list <- add_expr(
      data_list,
      substitute(
        expr = dataname %>%
          dplyr::filter(arm_var %in% arm_val),
        env = list(
          dataname = as.name(dataname),
          arm_var = as.name(arm_var),
          arm_val = if (compare_arm) c(ref_arm, comp_arm) else comp_arm
        )
      )
    )

    # Several reference levels are combined.
    if (length(ref_arm) > 1) {
      data_list <- add_expr(
        data_list,
        substitute_names(
          expr = dplyr::mutate(arm_var = combine_levels(arm_var, levels = ref_arm, new_level = ref_arm_val)),
          names = list(arm_var = as.name(arm_var)),
          others = list(ref_arm = ref_arm, ref_arm_val = ref_arm_val)
        )
      )
    }

    # Reference level is explicit.
    data_list <- add_expr(
      data_list,
      substitute_names(
        expr = dplyr::mutate(arm_var = stats::relevel(arm_var, ref = ref_arm_val)),
        names = list(arm_var = as.name(arm_var)),
        others = list(ref_arm_val = ref_arm_val)
      )
    )
  } else {
    data_list <- add_expr(
      data_list,
      substitute(
        expr = dataname,
        env = list(dataname = as.name(dataname))
      )
    )
  }

  # Unused levels are optionally dropped.
  if (drop) {
    data_list <- add_expr(
      data_list,
      substitute_names(
        expr = dplyr::mutate(arm_var = droplevels(arm_var)),
        names = list(arm_var = as.name(arm_var))
      )
    )
  }

  pipe_expr(data_list)
}

#' Expression: Prepare Arm Levels
#'
#' This function generates the standard expression for pre-processing of dataset
#' arm levels in and is used to apply the same steps in safety teal modules.
#'
#' @inheritParams template_arguments
#'
#' @return a `{` object. See [base::Paren()] for details.
#'
#' @examples
#' prepare_arm_levels(
#'   dataname = "adae",
#'   parentname = "adsl",
#'   arm_var = "ARMCD",
#'   drop_arm_levels = TRUE
#' )
#'
#' prepare_arm_levels(
#'   dataname = "adae",
#'   parentname = "adsl",
#'   arm_var = "ARMCD",
#'   drop_arm_levels = FALSE
#' )
#'
#' @export
prepare_arm_levels <- function(dataname,
                               parentname,
                               arm_var,
                               drop_arm_levels = TRUE) {
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_string(arm_var)
  checkmate::assert_flag(drop_arm_levels)

  data_list <- list()

  if (drop_arm_levels) {
    # Keep only levels that exist in `dataname` dataset
    data_list <- add_expr(
      data_list,
      substitute_names(
        expr = dataname <- dataname %>% dplyr::mutate(
          arm_var = droplevels(arm_var)
        ),
        names = list(
          dataname = as.name(dataname),
          arm_var = as.name(arm_var)
        )
      )
    )

    data_list <- add_expr(
      data_list,
      substitute(
        expr = arm_levels <- levels(dataname[[arm_var]]),
        env = list(
          dataname = as.name(dataname),
          arm_var = arm_var
        )
      )
    )

    # Data are filtered to keep only arms of interest.
    data_list <- add_expr(
      data_list,
      substitute(
        expr = parentname <- parentname %>%
          dplyr::filter(arm_var %in% arm_levels),
        env = list(
          parentname = as.name(parentname),
          arm_var = as.name(arm_var)
        )
      )
    )

    data_list <- add_expr(
      data_list,
      substitute_names(
        expr = parentname <- parentname %>% dplyr::mutate(
          arm_var = droplevels(arm_var)
        ),
        names = list(
          parentname = as.name(parentname),
          arm_var = as.name(arm_var)
        )
      )
    )
  } else {
    # Keep only levels that exist in `parentname` dataset
    data_list <- add_expr(
      data_list,
      substitute_names(
        expr = parentname <- parentname %>% dplyr::mutate(
          arm_var = droplevels(arm_var)
        ),
        names = list(
          parentname = as.name(parentname),
          arm_var = as.name(arm_var)
        )
      )
    )

    data_list <- add_expr(
      data_list,
      substitute(
        expr = arm_levels <- levels(parentname[[arm_var]]),
        env = list(
          parentname = as.name(parentname),
          arm_var = arm_var
        )
      )
    )

    data_list <- add_expr(
      data_list,
      substitute_names(
        expr = dataname <- dataname %>% dplyr::mutate(
          arm_var = factor(arm_var, levels = arm_levels)
        ),
        names = list(
          dataname = as.name(dataname),
          arm_var = as.name(arm_var)
        )
      )
    )
  }

  bracket_expr(data_list)
}

#' Mapping function for Laboratory Table
#'
#' Map value and level characters to values with with proper html tags, colors and icons.
#'
#' @param x (`character`)\cr vector with elements under the format (`value level`).
#' @param classes (`character`)\cr classes vector.
#' @param colors (`list`)\cr color per class.
#' @param default_color (`character`)\cr default color.
#' @param icons (`list`)\cr certain icons per level.
#'
#' @return a character vector where each element is a formatted HTML tag corresponding to
#'   a value in `x`.
#'
#' @examples
#' color_lab_values(c("LOW", "LOW", "HIGH", "NORMAL", "HIGH"))
#'
#' @export
color_lab_values <- function(x,
                             classes = c("HIGH", "NORMAL", "LOW"),
                             colors = list(HIGH = "red", NORMAL = "grey", LOW = "blue"),
                             default_color = "black",
                             icons = list(
                               HIGH = "glyphicon glyphicon-arrow-up",
                               LOW = "glyphicon glyphicon-arrow-down"
                             )) {
  is_character <- is.character(x) && is.vector(x)

  if ((!is_character) || !any(grepl(sprintf("(?:%s)", paste0(classes, collapse = "|")), x, perl = TRUE))) {
    x
  } else {
    vapply(x, function(val) {
      class <- classes[vapply(classes, function(class) {
        grepl(sprintf("%s", class), val)
      }, logical(1))]
      if (!is.null(class) & length(class) > 0) {
        color <- colors[class]
        if (is.null(color)) color <- default_color
        icony <- icons[class]
        value_val <- strsplit(val, " ")[[1]][1]
        sprintf("<span style='color:%s!important'>%s<i class='%s'></i></span>", color, value_val, icony)
      } else {
        val
      }
    }, character(1))
  }
}

#' Clean up categorical variable description
#'
#' Cleaning categorical variable descriptions before presenting.
#'
#' @param x (`character`)\cr vector with categories descriptions.
#'
#' @return a string
#'
#' @examples
#' clean_description("Level A (other text)")
#' clean_description("A long string that should be shortened")
#'
#' @export
clean_description <- function(x) {
  x <- gsub("\\(.*?\\)", "", x)
  x <- trimws(x)
  x <- gsub("[[:space:]]+", " ", x)
  x <- ifelse(nchar(x) > 20,
    yes = paste0(strtrim(x, width = 17), "..."),
    no = x
  )
  x
}

#' Utility function for extracting `paramcd` for forest plots
#'
#' Utility function for extracting `paramcd` for forest plots
#'
#' @param paramcd [`teal.transform::data_extract_spec()`]
#' variable value designating the studied parameter.
#'
#' @param input shiny app input
#'
#' @param filter_idx filter section index (default 1)
#' @keywords internal
#'
get_g_forest_obj_var_name <- function(paramcd, input, filter_idx = 1) {
  choices <- paramcd$filter[[filter_idx]]$choices
  input_obj <- paste0(
    "paramcd-dataset_", paramcd$dataname,
    "_singleextract-filter", filter_idx, "-vals"
  )
  current_selected <- input[[input_obj]]
  obj_var_name <- names(choices)[choices == current_selected]
  obj_var_name
}


#' Extract the associated parameter value for `paramcd`
#'
#' Utility function for extracting the parameter value that is associated
#' with the `paramcd` value label. If there is no parameter value for
#' the `paramcd` label, the `paramcd` value is returned. This is used
#' for generating the title.
#'
#' @param anl Analysis dataset
#'
#' @param paramcd [`teal.transform::data_extract_spec()`]
#' variable value designating the studied parameter.
#' @keywords internal
get_paramcd_label <- function(anl, paramcd) {
  positions <- grep(
    paste(unique(anl[[unlist(paramcd$filter)["vars_selected"]]]), collapse = "|"),
    names(unlist(paramcd$filter))
  )
  label_paramcd <- sapply(positions, function(pos) {
    if (nchar(sub(".*: ", "", names(unlist(paramcd$filter))[pos])) > 0) {
      label_paramcd <- sub(".*: ", "", names(unlist(paramcd$filter))[pos])
    } else {
      label_paramcd <- sub(":.*", "", names(unlist(paramcd$filter))[pos])
      label_paramcd <- sub(".*\\.", "", label_paramcd)
    }
    label_paramcd
  })
}

as_numeric_from_comma_sep_str <- function(input_string, sep = ",") {
  if (!is.null(input_string) && trimws(input_string) != "") {
    split_string <- unlist(strsplit(trimws(input_string), sep))
    split_as_numeric <- suppressWarnings(as.numeric(split_string))
  } else {
    split_as_numeric <- NULL
  }
  return(split_as_numeric)
}

#' Default string for total column label
#'
#' @description `r lifecycle::badge("stable")`
#'
#' The default string used as a label for the "total" column. This value is used as the default
#' value for the `total_label` argument throughout the `teal.modules.clinical` package. If not specified
#' for each module by the user via the `total_label` argument, or in the R environment options via
#' [set_default_total_label()], then `"All Patients"` is used.
#'
#' @param total_label (`string`)\cr Single string value to set in the R environment options as
#'   the default label to use for the "total" column. Use `getOption("tmc_default_total_label")` to
#'   check the current value set in the R environment (defaults to `"All Patients"` if not set).
#'
#' @name default_total_label
NULL

#' @describeIn default_total_label Getter for default total column label.
#'
#' @return
#' * `default_total_label` returns the current value if an R environment option has been set
#'   for `"tmc_default_total_label"`, or `"All Patients"` otherwise.
#'
#' @examples
#' # Default settings
#' default_total_label()
#' getOption("tmc_default_total_label")
#'
#' # Set custom value
#' set_default_total_label("All Patients")
#'
#' # Settings after value has been set
#' default_total_label()
#' getOption("tmc_default_total_label")
#'
#' @export
default_total_label <- function() {
  getOption("tmc_default_total_label", default = "All Patients")
}

#' @describeIn default_total_label Setter for default total column label. Sets the
#'   option `"tmc_default_total_label"` within the R environment.
#'
#' @return
#' * `set_default_total_label` has no return value.
#'
#' @export
set_default_total_label <- function(total_label) {
  checkmate::assert_character(total_label, len = 1, null.ok = TRUE)
  options("tmc_default_total_label" = total_label)
}

# for mocking in tests
interactive <- NULL

#' Substitute in Quoted Expressions
#'
#' This version of substitute is needed because [substitute()] does not
#' evaluate it's first argument, and it's often useful to be able to modify
#' a quoted expression.
#'
#' @md
#' @param qexpr (`language`)\cr a quoted expression.
#' @param env (`environment` or `list`)\cr requested variable substitutions.
#'
#' @return The modified expression.
#' @note This is simplified from the package `pryr` to avoid another dependency.
#' @seealso [substitute_names()]
#'
#' @keywords internal
#'
substitute_q <- function(qexpr, env) {
  stopifnot(is.language(qexpr))
  call <- substitute(substitute(qexpr, env), list(qexpr = qexpr))
  eval(call)
}

#' Substitute Names in a Quoted Expression
#'
#' This function substitutes the names on both left- and right-hand sides in a quoted expression.
#' In addition it can also do other standard substitutions on the right-hand side.
#'
#' @md
#' @param expr (`language`)\cr an expression.
#' @param names (named `list` of `name`)\cr requested name substitutions.
#' @param others (named `list`)\cr requested other substitutions which will only happen on the
#'   right-hand side.
#'
#' @name substitute_names
#' @return The modified expression.
#' @seealso [substitute_q()]
#'
#' @keywords internal
#'
substitute_names <- function(expr, names, others = list()) {
  checkmate::assert_list(names, min.len = 1, names = "unique", types = "name")
  checkmate::assert_list(others, min.len = 0, names = "unique")
  checkmate::assert_names(names(names), disjunct.from = names(others))

  expr <- substitute(expr)
  expr <- substitute_rhs(expr, c(names, others))
  substitute_lhs_names(expr, names)
}

#' @md
#' @describeIn substitute_names Helper function to just substitute the top-level names on the left-hand side in a
#'   quoted expression.
#' @inheritParams substitute_q
#' @keywords internal
h_subst_lhs_names <- function(qexpr, names) {
  will_replace <- names(names)
  to_replace <- names(qexpr)
  matches <- match(x = to_replace, table = will_replace)
  which_found <- which(!is.na(matches))
  names_as_strings <- sapply(names, as.character)
  names(qexpr)[which_found] <- names_as_strings[matches[which_found]]
  qexpr
}

#' @md
#' @describeIn substitute_names recursively substitutes all names on the left-hand sides in a quoted expression.
#' @inheritParams substitute_q
#' @keywords internal
substitute_lhs_names <- function(qexpr, names) {
  if (length(qexpr) == 1L) {
    return(qexpr)
  }
  qexpr <- h_subst_lhs_names(qexpr, names)
  for (i in seq_along(qexpr)) {
    qexpr[[i]] <- substitute_lhs_names(qexpr[[i]], names)
  }
  qexpr
}

#' @md
#' @describeIn substitute_names substitutes on the right-hand side in a quoted expression.
#'   Note that this is just a synonym for [substitute_q()].
#' @inheritParams substitute_q
#' @keywords internal
substitute_rhs <- function(qexpr, env) {
  substitute_q(qexpr, env)
}

#' Template: Logistic Regression
#'
#' Creates a valid expression to generate a logistic regression table.
#'
#' @inheritParams template_arguments
#' @inheritParams tern::tidy.glm
#' @param arm_var (`character`)\cr variable names that can be used as `arm_var`. To fit a logistic model with no
#'   arm/treatment variable, set to `NULL`.
#' @param topleft (`character`)\cr text to use as top-left annotation in the table.
#' @param interaction_var (`character`)\cr names of the variables that can be used for interaction variable selection.
#' @param responder_val (`character`)\cr values of the responder variable corresponding with a successful response.
#' @param paramcd `r lifecycle::badge("deprecated")` The `paramcd` argument is not used in this function.
#' @param label_paramcd (`character`)\cr label of response parameter value to print in the table title.
#'
#' @inherit template_arguments return
#'
#' @seealso [tm_t_logistic()]
#'
#' @keywords internal
template_logistic <- function(dataname,
                              arm_var,
                              aval_var,
                              paramcd = lifecycle::deprecated(),
                              label_paramcd,
                              cov_var,
                              interaction_var,
                              ref_arm,
                              comp_arm,
                              topleft = "Logistic Regression",
                              conf_level = 0.95,
                              combine_comp_arms = FALSE,
                              responder_val = c("CR", "PR"),
                              at = NULL,
                              basic_table_args = teal.widgets::basic_table_args()) {
  if (lifecycle::is_present(paramcd)) {
    lifecycle::deprecate_warn("0.8.16", "template_logistic(paramcd)")
  }

  # Common assertion no matter if arm_var is NULL or not.
  checkmate::assert_string(dataname)
  checkmate::assert_string(aval_var)
  checkmate::assert_string(label_paramcd, null.ok = TRUE)
  checkmate::assert_string(topleft, null.ok = TRUE)
  checkmate::assert_character(cov_var, null.ok = TRUE)
  checkmate::assert_string(interaction_var, null.ok = TRUE)

  y <- list()

  data_pipe <- list()
  data_list <- list()

  # Conditional assertion depends on if arm_var isn't NULL.
  if (!is.null(arm_var)) {
    checkmate::assert_string(arm_var)
    checkmate::assert_flag(combine_comp_arms)

    ref_arm_val <- paste(ref_arm, collapse = "/")

    y$arm_lab <- substitute(
      expr = arm_var_lab <- teal.data::col_labels(anl[arm_var], fill = FALSE),
      env = list(anl = as.name(dataname), arm_var = arm_var)
    )

    # Start to build data when arm_var is not NULL.
    data_pipe <- add_expr(
      data_pipe,
      prepare_arm(
        dataname = dataname,
        arm_var = arm_var,
        ref_arm = ref_arm,
        comp_arm = comp_arm,
        ref_arm_val = ref_arm_val
      )
    )

    if (combine_comp_arms) {
      data_pipe <- add_expr(
        data_pipe,
        substitute_names(
          expr = dplyr::mutate(arm_var = combine_levels(x = arm_var, levels = comp_arm)),
          names = list(arm_var = as.name(arm_var)),
          others = list(comp_arm = comp_arm)
        )
      )
    }

    data_list <- add_expr(
      data_list,
      substitute(
        expr = ANL <- data_pipe,
        env = list(data_pipe = pipe_expr(data_pipe))
      )
    )
  }

  data_list <- add_expr(
    data_list,
    substitute(
      expr = ANL <- df %>%
        dplyr::mutate(Response = aval_var %in% responder_val) %>%
        df_explicit_na(na_level = "_NA_"),
      env = list(df = as.name("ANL"), aval_var = as.name(aval_var), responder_val = responder_val)
    )
  )

  y$data <- bracket_expr(data_list)

  if (!is.null(arm_var)) {
    y$relabel <- substitute(
      expr = teal.data::col_labels(ANL[arm_var]) <- arm_var_lab,
      env = list(arm_var = arm_var)
    )
  }

  model_list <- list()
  model_list <- if (is.null(interaction_var)) {
    add_expr(
      model_list,
      substitute(
        expr = fit_logistic(
          ANL,
          variables = list(response = "Response", arm = arm_var, covariates = cov_var)
        ),
        env = list(arm_var = arm_var, cov_var = cov_var)
      )
    )
  } else {
    add_expr(
      model_list,
      substitute(
        expr = fit_logistic(
          ANL,
          variables = list(
            response = "Response", arm = arm_var, covariates = cov_var,
            interaction = interaction_var
          )
        ),
        env = list(arm_var = arm_var, cov_var = cov_var, interaction_var = interaction_var)
      )
    )
  }

  model_list <- if (is.null(interaction_var)) {
    add_expr(
      model_list,
      substitute(
        expr = broom::tidy(conf_level = conf_level),
        env = list(conf_level = conf_level)
      )
    )
  } else {
    add_expr(
      model_list,
      substitute(
        expr = broom::tidy(conf_level = conf_level, at = at),
        env = list(conf_level = conf_level, at = at)
      )
    )
  }

  model_list <- add_expr(model_list, quote(df_explicit_na(na_level = "_NA_")))

  y$model <- substitute(
    expr = mod <- model_pipe,
    env = list(model_pipe = pipe_expr(model_list))
  )

  layout_list <- list()

  basic_title <- if (length(responder_val) > 1) {
    paste(
      "Summary of Logistic Regression Analysis for", label_paramcd, "for",
      paste(utils::head(responder_val, -1), collapse = ", "),
      "and", utils::tail(responder_val, 1), "Responders"
    )
  } else {
    paste("Summary of Logistic Regression Analysis for", label_paramcd, "for", responder_val, "Responders")
  }

  parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
    teal.widgets::resolve_basic_table_args(
      user_table = basic_table_args,
      module_table = teal.widgets::basic_table_args(title = basic_title)
    )
  )

  y$table <- substitute(
    expr = {
      result <- expr_basic_table_args %>%
        summarize_logistic(
          conf_level = conf_level,
          drop_and_remove_str = "_NA_"
        ) %>%
        rtables::append_topleft(topleft) %>%
        rtables::build_table(df = mod)
      result
    },
    env = list(
      expr_basic_table_args = parsed_basic_table_args,
      conf_level = conf_level,
      topleft = topleft
    )
  )

  y
}

#' teal Module: Logistic Regression
#'
#' This module produces a multi-variable logistic regression table consistent with the TLG Catalog template
#' `LGRT02` available [here](https://insightsengineering.github.io/tlg-catalog/stable/tables/efficacy/lgrt02.html).
#'
#' @inheritParams module_arguments
#' @inheritParams template_logistic
#' @param arm_var ([teal.transform::choices_selected()] or `NULL`)\cr object
#'   with all available choices and preselected option for variable names that can be used as `arm_var`. This defines
#'   the grouping variable(s) in the results table. If there are two elements selected for `arm_var`, the second
#'   variable will be nested under the first variable. If `NULL`, no arm/treatment variable is included in the
#'   logistic model.
#' @param avalc_var ([teal.transform::choices_selected()])\cr object with all
#'   available choices and preselected option for the analysis variable (categorical).
#'
#' @inherit module_arguments return seealso
#'
#' @examples
#' library(dplyr)
#'
#' ADSL <- tmc_ex_adsl
#' ADRS <- tmc_ex_adrs %>%
#'   filter(PARAMCD %in% c("BESRSPI", "INVET"))
#'
#' arm_ref_comp <- list(
#'   ACTARMCD = list(
#'     ref = "ARM B",
#'     comp = c("ARM A", "ARM C")
#'   ),
#'   ARM = list(
#'     ref = "B: Placebo",
#'     comp = c("A: Drug X", "C: Combination")
#'   )
#' )
#'
#' app <- init(
#'   data = cdisc_data(
#'     ADSL = ADSL,
#'     ADRS = ADRS,
#'     code = "
#'       ADSL <- tmc_ex_adsl
#'       ADRS <- tmc_ex_adrs %>%
#'         filter(PARAMCD %in% c(\"BESRSPI\", \"INVET\"))
#'     "
#'   ),
#'   modules = modules(
#'     tm_t_logistic(
#'       label = "Logistic Regression",
#'       dataname = "ADRS",
#'       arm_var = choices_selected(
#'         choices = variable_choices(ADRS, c("ARM", "ARMCD")),
#'         selected = "ARM"
#'       ),
#'       arm_ref_comp = arm_ref_comp,
#'       paramcd = choices_selected(
#'         choices = value_choices(ADRS, "PARAMCD", "PARAM"),
#'         selected = "BESRSPI"
#'       ),
#'       cov_var = choices_selected(
#'         choices = c("SEX", "AGE", "BMRKR1", "BMRKR2"),
#'         selected = "SEX"
#'       )
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
#' @export
tm_t_logistic <- function(label,
                          dataname,
                          parentname = ifelse(
                            inherits(arm_var, "data_extract_spec"),
                            teal.transform::datanames_input(arm_var),
                            "ADSL"
                          ),
                          arm_var = NULL,
                          arm_ref_comp = NULL,
                          paramcd,
                          cov_var = NULL,
                          avalc_var = teal.transform::choices_selected(
                            teal.transform::variable_choices(dataname, "AVALC"), "AVALC",
                            fixed = TRUE
                          ),
                          conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE),
                          pre_output = NULL,
                          post_output = NULL,
                          basic_table_args = teal.widgets::basic_table_args()) {
  message("Initializing tm_t_logistic")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(parentname)
  checkmate::assert_class(arm_var, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(paramcd, "choices_selected")
  checkmate::assert_class(cov_var, "choices_selected", null.ok = TRUE)
  checkmate::assert_class(avalc_var, "choices_selected")
  checkmate::assert_class(conf_level, "choices_selected")
  checkmate::assert_list(arm_ref_comp, names = "named", null.ok = TRUE)
  checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
  checkmate::assert_class(basic_table_args, "basic_table_args")

  args <- as.list(environment())

  data_extract_list <- list(
    arm_var = `if`(is.null(arm_var), NULL, cs_to_des_select(arm_var, dataname = parentname)),
    paramcd = cs_to_des_filter(paramcd, dataname = dataname),
    cov_var = cs_to_des_select(cov_var, dataname = dataname, multiple = TRUE),
    avalc_var = cs_to_des_select(avalc_var, dataname = dataname)
  )

  module(
    label = label,
    server = srv_t_logistic,
    ui = ui_t_logistic,
    ui_args = c(data_extract_list, args),
    server_args = c(
      data_extract_list,
      list(
        arm_ref_comp = arm_ref_comp,
        label = label,
        dataname = dataname,
        parentname = parentname,
        basic_table_args = basic_table_args
      )
    ),
    datanames = teal.transform::get_extract_datanames(data_extract_list)
  )
}

#' @keywords internal
ui_t_logistic <- function(id, ...) {
  a <- list(...)
  if (!is.null(a$arm_var)) {
    is_single_dataset_value <- teal.transform::is_single_dataset(
      a$arm_var,
      a$paramcd,
      a$avalc_var,
      a$cov_var
    )
  } else {
    is_single_dataset_value <- teal.transform::is_single_dataset(
      a$paramcd,
      a$avalc_var,
      a$cov_var
    )
  }

  ns <- NS(id)
  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(
      teal.widgets::table_with_settings_ui(ns("table"))
    ),
    encoding = tags$div(
      ### Reporter
      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
      ###
      tags$label("Encodings", class = "text-primary"),
      teal.transform::datanames_input(a[c("arm_var", "paramcd", "avalc_var", "cov_var")]),
      teal.transform::data_extract_ui(
        id = ns("paramcd"),
        label = "Select Endpoint",
        data_extract_spec = a$paramcd,
        is_single_dataset = is_single_dataset_value
      ),
      teal.transform::data_extract_ui(
        id = ns("avalc_var"),
        label = "Analysis Variable",
        data_extract_spec = a$avalc_var,
        is_single_dataset = is_single_dataset_value
      ),
      selectInput(
        ns("responders"),
        "Responders",
        choices = c("CR", "PR"),
        selected = c("CR", "PR"),
        multiple = TRUE
      ),
      if (!is.null(a$arm_var)) {
        tags$div(
          teal.transform::data_extract_ui(
            id = ns("arm_var"),
            label = "Select Treatment Variable",
            data_extract_spec = a$arm_var,
            is_single_dataset = is_single_dataset_value
          ),
          uiOutput(ns("arms_buckets")),
          checkboxInput(
            ns("combine_comp_arms"),
            "Combine all comparison groups?",
            value = FALSE
          )
        )
      },
      teal.transform::data_extract_ui(
        id = ns("cov_var"),
        label = "Covariates",
        data_extract_spec = a$cov_var,
        is_single_dataset = is_single_dataset_value
      ),
      uiOutput(ns("interaction_variable")),
      uiOutput(ns("interaction_input")),
      teal.widgets::optionalSelectInput(
        inputId = ns("conf_level"),
        label = tags$p(
          "Confidence level for ",
          tags$span(class = "text-primary", "Coxph"),
          " (Hazard Ratio)",
          sep = ""
        ),
        a$conf_level$choices,
        a$conf_level$selected,
        multiple = FALSE,
        fixed = a$conf_level$fixed
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

#' @keywords internal
srv_t_logistic <- function(id,
                           data,
                           reporter,
                           filter_panel_api,
                           dataname,
                           parentname,
                           arm_var,
                           arm_ref_comp,
                           paramcd,
                           avalc_var,
                           cov_var,
                           label,
                           basic_table_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
    # Observer to update reference and comparison arm input options.
    iv_arco <- arm_ref_comp_observer(
      session,
      input,
      output,
      id_arm_var = extract_input("arm_var", parentname),
      data = reactive(data()[[parentname]]),
      arm_ref_comp = arm_ref_comp,
      module = "tm_t_logistic"
    )

    selector_list <- teal.transform::data_extract_multiple_srv(
      data_extract = list(
        arm_var = arm_var,
        paramcd = paramcd,
        avalc_var = avalc_var,
        cov_var = cov_var
      ),
      datasets = data,
      select_validation_rule = list(
        arm_var = shinyvalidate::sv_required("Treatment Variable is empty"),
        avalc_var = shinyvalidate::sv_required("Analysis variable is empty"),
        cov_var = shinyvalidate::sv_required("`Covariates` field is empty")
      ),
      filter_validation_rule = list(
        paramcd = shinyvalidate::sv_required("`Select Endpoint` field is empty")
      )
    )

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("responders", shinyvalidate::sv_required("`Responders` field is empty"))
      iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level."))
      iv$add_rule("conf_level", shinyvalidate::sv_between(
        0, 1,
        message_fmt = "Confdence level must be between {left} and {right}."
      ))
      iv$add_validator(iv_arco)
      # Conditional validator for interaction values.
      iv_int <- shinyvalidate::InputValidator$new()
      iv_int$condition(
        ~ length(input$interaction_var) > 0L &&
          is.numeric(merged$anl_q()[["ANL"]][[input$interaction_var]])
      )
      iv_int$add_rule("interaction_values", shinyvalidate::sv_required(
        "If interaction is specified the level should be entered."
      ))
      iv_int$add_rule(
        "interaction_values",
        ~ if (anyNA(as_numeric_from_comma_sep_str(.))) {
          "Interaction levels are invalid."
        }
      )
      iv_int$add_rule(
        "interaction_values",
        ~ if (any(duplicated(as_numeric_from_comma_sep_str(.)))) {
          "Interaction levels must be unique."
        }
      )
      iv$add_validator(iv_int)
      teal.transform::compose_and_enable_validators(iv, selector_list)
    })

    anl_inputs <- teal.transform::merge_expression_srv(
      selector_list = selector_list,
      datasets = data,
      merge_function = "dplyr::inner_join"
    )

    adsl_inputs <- teal.transform::merge_expression_module(
      datasets = data,
      data_extract = list(arm_var = arm_var),
      anl_name = "ANL_ADSL"
    )

    anl_q <- reactive({
      data() %>%
        teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
        teal.code::eval_code(as.expression(adsl_inputs()$expr))
    })

    merged <- list(
      anl_input_r = anl_inputs,
      adsl_input_r = adsl_inputs,
      anl_q = anl_q
    )

    # Because the AVALC values depends on the selected PARAMCD.
    observeEvent(merged$anl_input_r(), {
      avalc_var <- merged$anl_input_r()$columns_source$avalc_var
      if (nrow(merged$anl_q()[["ANL"]]) == 0) {
        responder_choices <- c("CR", "PR")
        responder_sel <- c("CR", "PR")
      } else {
        if (length(avalc_var) == 0) {
          return(NULL)
        }
        responder_choices <- unique(merged$anl_q()[["ANL"]][[avalc_var]])
        responder_sel <- intersect(responder_choices, isolate(input$responders))
      }
      updateSelectInput(
        session, "responders",
        choices = responder_choices,
        selected = responder_sel
      )
    })

    output$interaction_variable <- renderUI({
      cov_var <- as.vector(merged$anl_input_r()$columns_source$cov_var)
      if (length(cov_var) > 0) {
        teal.widgets::optionalSelectInput(
          session$ns("interaction_var"),
          label = "Interaction",
          choices = cov_var,
          selected = NULL,
          multiple = FALSE
        )
      } else {
        NULL
      }
    })

    output$interaction_input <- renderUI({
      interaction_var <- input$interaction_var
      if (length(interaction_var) > 0) {
        if (is.numeric(merged$anl_q()[["ANL"]][[interaction_var]])) {
          tagList(
            textInput(
              session$ns("interaction_values"),
              label = sprintf("Specify %s values (comma delimited) for treatment ORs calculation:", interaction_var),
              value = as.character(stats::median(merged$anl_q()[["ANL"]][[interaction_var]]))
            )
          )
        }
      } else {
        NULL
      }
    })

    validate_checks <- reactive({
      adsl_filtered <- anl_q()[[parentname]]
      anl_filtered <- anl_q()[[dataname]]

      validate_inputs(iv_r())

      input_arm_var <- as.vector(merged$anl_input_r()$columns_source$arm_var)
      input_avalc_var <- as.vector(merged$anl_input_r()$columns_source$avalc_var)
      input_cov_var <- as.vector(merged$anl_input_r()$columns_source$cov_var)
      input_paramcd <- unlist(paramcd$filter)["vars_selected"]
      input_interaction_var <- input$interaction_var

      input_interaction_at <- input_interaction_var[input_interaction_var %in% input_cov_var]

      at_values <- as_numeric_from_comma_sep_str(input$interaction_values)

      # validate inputs
      validate_args <- list(
        adsl = adsl_filtered,
        adslvars = c("USUBJID", "STUDYID", input_arm_var),
        anl = anl_filtered,
        anlvars = c("USUBJID", "STUDYID", input_paramcd, input_avalc_var, input_cov_var),
        arm_var = input_arm_var,
        ref_arm = unlist(input$buckets$Ref),
        comp_arm = unlist(input$buckets$Comp),
        min_nrow = 4
      )

      # validate arm levels
      if (!is.null(arm_var)) {
        if (length(input_arm_var) > 0 && length(unique(adsl_filtered[[input_arm_var]])) == 1) {
          validate_args <- append(validate_args, list(min_n_levels_armvar = NULL))
        }

        do.call(what = "validate_standard_inputs", validate_args)

        arm_n <- base::table(merged$anl_q()[["ANL"]][[input_arm_var]])
        anl_arm_n <- if (input$combine_comp_arms) {
          c(sum(arm_n[unlist(input$buckets$Ref)]), sum(arm_n[unlist(input$buckets$Comp)]))
        } else {
          c(sum(arm_n[unlist(input$buckets$Ref)]), arm_n[unlist(input$buckets$Comp)])
        }
        validate(shiny::need(
          all(anl_arm_n >= 2),
          "Each treatment group should have at least 2 records."
        ))
      }

      # validate covariate has at least two levels
      validate(
        need(
          all(
            vapply(
              merged$anl_q()[["ANL"]][input_cov_var],
              FUN = function(x) {
                length(unique(x)) > 1
              },
              logical(1)
            )
          ),
          "All covariates need to have at least two levels"
        )
      )
    })

    all_q <- reactive({
      validate_checks()

      ANL <- merged$anl_q()[["ANL"]]

      label_paramcd <- get_paramcd_label(ANL, paramcd)

      paramcd <- as.character(unique(ANL[[unlist(paramcd$filter)["vars_selected"]]]))

      interaction_var <- input$interaction_var
      interaction_flag <- length(interaction_var) != 0

      at_values <- as_numeric_from_comma_sep_str(input$interaction_values)
      at_flag <- interaction_flag && is.numeric(ANL[[interaction_var]])

      cov_var <- names(merged$anl_input_r()$columns_source$cov_var)

      calls <- template_logistic(
        dataname = "ANL",
        arm_var = names(merged$anl_input_r()$columns_source$arm_var),
        aval_var = names(merged$anl_input_r()$columns_source$avalc_var),
        label_paramcd = label_paramcd,
        cov_var = if (length(cov_var) > 0) cov_var else NULL,
        interaction_var = if (interaction_flag) interaction_var else NULL,
        ref_arm = unlist(input$buckets$Ref),
        comp_arm = unlist(input$buckets$Comp),
        combine_comp_arms = input$combine_comp_arms,
        topleft = paramcd,
        conf_level = as.numeric(input$conf_level),
        at = if (at_flag) at_values else NULL,
        responder_val = input$responders,
        basic_table_args = basic_table_args
      )

      teal.code::eval_code(merged$anl_q(), as.expression(calls))
    })

    table_r <- reactive(all_q()[["result"]])

    teal.widgets::table_with_settings_srv(
      id = "table",
      table_r = table_r
    )

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(teal.code::get_code(all_q())),
      title = label
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- teal::report_card_template(
          title = "Logistic Regression Table",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api
        )
        card$append_text("Table", "header3")
        card$append_table(table_r())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(teal.code::get_code(all_q()))
        card
      }
      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Validate standard input values for a teal module
#'
#' @description `r lifecycle::badge("stable")`
#' @param adsl data.frame with subject-level data
#' @param adslvars required variables from `ADSL`
#' @param anl data.frame with analysis data
#' @param anlvars required variables from `ANL`
#' @param need_arm flag indicating whether grouping variable `arm_var`
#' is required or can be optionally `NULL`.
#' @param arm_var character with name of grouping variable, typically arm
#' @param ref_arm character with name of reference level in `arm_var`
#' @param comp_arm character with name for comparison level in `arm_var`
#' @param min_n_levels_armvar minimum number of levels in grouping variable `arm_var`.
#'   Defaults to 1, `NULL` for no minimum.
#' @param max_n_levels_armvar maximum number of levels in grouping variable `arm_var`.
#'   Use `NULL` for no maximum.
#' @param min_nrow minimum number of observations in `ADSL` and `ANL`
#'
#' @keywords internal
#'
validate_standard_inputs <- function(adsl,
                                     adslvars = character(0),
                                     anl,
                                     anlvars = character(0),
                                     need_arm = TRUE,
                                     arm_var,
                                     ref_arm,
                                     comp_arm,
                                     min_n_levels_armvar = 1L,
                                     max_n_levels_armvar = 100L,
                                     min_nrow = 1) {
  teal::validate_has_data(adsl, min_nrow = min_nrow)
  teal::validate_has_data(anl, min_nrow = min_nrow)

  if (length(adslvars) > 0) {
    teal::validate_has_variable(adsl, c(adslvars, arm_var))
  }
  if (length(anlvars) > 0) {
    teal::validate_has_variable(anl, anlvars)
  }

  if (need_arm || (!(need_arm) && !is.null(arm_var))) {
    teal::validate_has_elements(arm_var, "Treatment variable name is empty.")
    teal::validate_has_variable(adsl, arm_var, "Treatment variable not found.")

    validate_n_levels(
      adsl[[arm_var]],
      min_levels = min_n_levels_armvar,
      max_levels = max_n_levels_armvar,
      var_name = arm_var
    )

    validate_arm(adsl[[arm_var]])

    if (!missing(comp_arm)) {
      teal::validate_has_elements(comp_arm, "Comparison treatments selection is empty.")
    }
    if (!missing(ref_arm)) {
      teal::validate_has_elements(ref_arm, "Reference treatments selection is empty.")
    }

    if (!missing(comp_arm) && !missing(ref_arm)) {
      teal::validate_in(
        c(comp_arm, ref_arm), adsl[[arm_var]],
        "Current ADSL data does not have observations from the reference and comparison treatments."
      )
    }
  }
}

#' Check if vector is valid as to be used as a treatment arm variable
#'
#' @details A validate error is returned if the vector is not a factor with a more detailed
#'   error message if any of the entries are empty strings
#' @param arm_vec vector to be validated
#' @keywords internal
#'
validate_arm <- function(arm_vec) {
  validate(shiny::need(is.factor(arm_vec), "Treatment variable is not a factor"))
  validate(
    need(
      all(trimws(levels(arm_vec)) != ""),
      "Treatment values cannot contain empty strings"
    )
  )
}

# This file contains functions that help with plotting in other modules

#' Facetting formula `x_facet ~ y_facet`
#'
#' @description `r lifecycle::badge("stable")`
#' Replaces `x_facet` or `y_facet` by . when empty character
#'
#' @md
#' @param x_facet (`character(1)`)\cr
#'  name of x facet, if empty, will not facet along x.
#' @param y_facet (`character(1)`)\cr
#'  name of y facet, if empty, will not facet along y.
#'
#' @return facet grid formula `formula(x_facet ~ y_facet)`
#'
#' @keywords internal
#'
facet_grid_formula <- function(x_facet, y_facet) {
  if (length(x_facet) == 0) x_facet <- "."
  if (length(y_facet) == 0) y_facet <- "."
  checkmate::assert_string(x_facet)
  checkmate::assert_string(y_facet)
  if (x_facet == y_facet) stop("'x_facet' and 'y_facet' must not be equal.")
  stats::as.formula(paste0(y_facet, " ~ ", x_facet)) # must invert it
}

#' Get full label, useful for annotating plots
#'
#' @param dataset (`data.frame`)\cr dataset
#' @param column (`character`)\cr column to get label from
#' @param omit_raw_name (`logical`)\cr omits the raw name in square brackets if label is found
#'
#' @return "Label `[Column name]`" if label exists, otherwise "Column name".
#'
#' @examples
#' data <- mtcars
#' column_annotation_label(data, "cyl")
#' attr(data[["cyl"]], "label") <- "Cylinder"
#' column_annotation_label(data, "cyl")
#' column_annotation_label(data, "cyl", omit_raw_name = TRUE)
#' column_annotation_label(tmc_ex_adsl, "ACTARM")
#' @export
column_annotation_label <- function(dataset, column, omit_raw_name = FALSE) {
  checkmate::assert_data_frame(dataset)
  checkmate::assert_string(column)
  checkmate::assert_flag(omit_raw_name)

  if (is.null(attr(dataset[[column]], "label"))) {
    column
  } else {
    col_label <- attr(dataset[[column]], "label")
    if (omit_raw_name) {
      col_label
    } else {
      sprintf("%s [%s]", col_label, column)
    }
  }
}

1		.onLoad <- function(libname, pkgname) {
2	!	teal.logger::register_logger(namespace = "teal.modules.clinical")
3	!	teal.logger::register_handlers("teal.modules.clinical")
4	!	tern::set_default_na_str("<Missing>")
5		}

1		#' Template: Line Plot
2		#'
3		#' Creates a valid expression to generate a [ggplot2::ggplot()] line plot.
4		#'
5		#' @inheritParams tern::g_lineplot
6		#' @inheritParams tern::control_lineplot_vars
7		#' @inheritParams template_arguments
8		#' @param strata (`string` or `NA`)\cr group variable name.
9		#' @param param (`character`)\cr parameter to filter the data by.
10		#' @param incl_screen (`logical`)\cr whether the screening visit should be included.
11		#' @param ggplot2_args (`ggplot2_args`) optional\cr object created by [teal.widgets::ggplot2_args()] with settings
12		#' for the module plot. For this module, this argument will only accept `ggplot2_args` object with `labs` list of
13		#' following child elements: `title`, `subtitle`, `caption`, `y`, `lty`. No other elements would be taken into
14		#' account. The argument is merged with option `teal.ggplot2_args` and with default module arguments (hard coded in
15		#' the module body).
16		#'
17		#' For more details, see the vignette: `vignette("custom-ggplot2-arguments", package = "teal.widgets")`.
18		#'
19		#' @inherit template_arguments return
20		#'
21		#' @seealso [tm_g_lineplot()]
22		#'
23		#' @keywords internal
24		template_g_lineplot <- function(dataname = "ANL",
25		strata = "ARM",
26		x = "AVISIT",
27		y = "AVAL",
28		y_unit = "AVALU",
29		paramcd = "PARAMCD",
30		param = "ALT",
31		mid = "mean",
32		interval = "mean_ci",
33		whiskers = c("mean_ci_lwr", "mean_ci_upr"),
34		table = c("n", "mean_sd", "median", "range"),
35		mid_type = "pl",
36		conf_level = 0.95,
37		incl_screen = TRUE,
38		mid_point_size = 2,
39		table_font_size = 4,
40		title = "Line Plot",
41		y_lab = "",
42		ggplot2_args = teal.widgets::ggplot2_args()) {
43	2x	checkmate::assert_string(dataname)
44	2x	checkmate::assert_string(strata)
45	2x	checkmate::assert_string(x)
46	2x	checkmate::assert_string(y)
47	2x	checkmate::assert_string(y_unit)
48	2x	checkmate::assert_string(paramcd)
49	2x	checkmate::assert_string(title)
50	2x	checkmate::assert_string(y_lab)
51
52	2x	z <- list()
53
54	2x	data_list <- list()
55
56	2x	data_list <- add_expr(
57	2x	data_list,
58	2x	substitute(
59	2x	expr = anl,
60	2x	env = list(anl = as.name(dataname))
61		)
62		)
63
64	2x	if (!incl_screen) {
65	1x	data_list <- add_expr(
66	1x	data_list,
67	1x	substitute_names(
68	1x	expr = dplyr::filter(x_var != "SCREENING") %>%
69	1x	dplyr::mutate(x_var = factor(x_var)),
70	1x	names = list(x_var = as.name(x))
71		)
72		)
73		}
74
75		# droplevels for strata
76	2x	data_list <- add_expr(
77	2x	data_list,
78	2x	substitute_names(
79	2x	expr = dplyr::mutate(
80	2x	arm_var = droplevels(arm_var)
81		),
82	2x	names = list(
83	2x	arm_var = as.name(strata)
84		)
85		)
86		)
87
88	2x	z$data <- substitute(
89	2x	expr = {
90	!	anl <- data_pipe
91		},
92	2x	env = list(
93	2x	data_pipe = pipe_expr(data_list)
94		)
95		)
96
97	2x	z$variables <- substitute(
98	2x	expr = variables <- control_lineplot_vars(x = x, y = y, group_var = arm, paramcd = paramcd, y_unit = y_unit),
99	2x	env = list(x = x, y = y, arm = strata, paramcd = paramcd, y_unit = y_unit)
100		)
101
102	2x	mid_choices <- c(
103	2x	"Mean" = "mean",
104	2x	"Median" = "median"
105		)
106
107	2x	interval_choices <- c(
108	2x	"Mean Confidence Interval" = "mean_ci",
109	2x	"Median Confidence Interval" = "median_ci",
110	2x	"25% and 75% Quantiles" = "quantiles",
111	2x	"Range" = "range"
112		)
113
114	2x	graph_list <- list()
115
116	2x	graph_list <- add_expr(
117	2x	graph_list,
118	2x	quote(grid::grid.newpage())
119		)
120
121	2x	all_ggplot2_args <- teal.widgets::resolve_ggplot2_args(
122	2x	user_plot = ggplot2_args,
123	2x	module_plot = teal.widgets::ggplot2_args(
124	2x	labs = list(
125	2x	title = paste0(
126	2x	"Plot of ", names(which(mid_choices == mid)),
127	2x	if (!is.null(interval)) {
128	2x	paste0(
129	2x	" and ",
130	2x	if (interval %in% c("mean_ci", "median_ci")) paste0(conf_level * 100, "% "),
131	2x	names(which(interval_choices == interval))
132		)
133		},
134	2x	" of ", y, " by Visit"
135		),
136	2x	subtitle = "",
137	2x	y = sprintf("%s %s Values for", y, names(which(mid_choices == mid)))
138		)
139		)
140		)
141
142	2x	plot_call <- substitute(
143	2x	g_lineplot(
144	2x	df = anl,
145	2x	variables = variables,
146	2x	interval = interval,
147	2x	mid = mid,
148	2x	whiskers = whiskers,
149	2x	table = table,
150	2x	mid_type = mid_type,
151	2x	mid_point_size = mid_point_size,
152	2x	table_font_size = table_font_size,
153	2x	newpage = FALSE,
154	2x	title = ggplot2_args_title,
155	2x	subtitle = ggplot2_args_subtitle,
156	2x	caption = ggplot2_args_caption,
157	2x	y_lab = ggplot2_args_ylab,
158	2x	legend_title = ggplot2_args_legend_title,
159	2x	ggtheme = ggplot2::theme_minimal(),
160	2x	control = control_analyze_vars(conf_level = conf_level),
161	2x	subtitle_add_paramcd = FALSE,
162	2x	subtitle_add_unit = FALSE
163		),
164	2x	env = list(
165	2x	conf_level = conf_level,
166	2x	interval = interval,
167	2x	mid = mid,
168	2x	whiskers = whiskers,
169	2x	table = table,
170	2x	mid_type = mid_type,
171	2x	mid_choices = mid_choices,
172	2x	interval_choices = interval_choices,
173	2x	mid_point_size = mid_point_size,
174	2x	table_font_size = table_font_size,
175	2x	y = y,
176	2x	ggplot2_args_title = all_ggplot2_args$labs$title,
177	2x	ggplot2_args_subtitle = all_ggplot2_args$labs$subtitle,
178	2x	ggplot2_args_caption = all_ggplot2_args$labs$caption,
179	2x	ggplot2_args_ylab = all_ggplot2_args$labs$y,
180	2x	ggplot2_args_legend_title = all_ggplot2_args$labs$lty
181		)
182		)
183
184	2x	graph_list <- add_expr(
185	2x	graph_list,
186	2x	substitute(
187	2x	expr = {
188	!	plot <- plot_call
189	!	plot
190		},
191	2x	env = list(plot_call = plot_call)
192		)
193		)
194
195	2x	z$graph <- bracket_expr(graph_list)
196
197	2x	z
198		}
199
200		#' teal Module: Line Plot
201		#'
202		#' This module produces a [ggplot2::ggplot()] type line plot, with optional summary table, for standard ADaM data.
203		#'
204		#' @inheritParams module_arguments
205		#' @inheritParams template_g_lineplot
206		#'
207		#' @inherit module_arguments return seealso
208		#'
209		#' @examples
210		#' library(nestcolor)
211		#' library(dplyr)
212		#' library(forcats)
213		#'
214		#' ADSL <- tmc_ex_adsl
215		#' ADLB <- tmc_ex_adlb %>% mutate(AVISIT == fct_reorder(AVISIT, AVISITN, min))
216		#'
217		#' app <- init(
218		#' data = cdisc_data(
219		#' ADSL = ADSL,
220		#' ADLB = ADLB,
221		#' code = "
222		#' ADSL <- tmc_ex_adsl
223		#' ADLB <- tmc_ex_adlb %>% mutate(AVISIT == fct_reorder(AVISIT, AVISITN, min))
224		#' "
225		#' ),
226		#' modules = modules(
227		#' tm_g_lineplot(
228		#' label = "Line Plot",
229		#' dataname = "ADLB",
230		#' strata = choices_selected(
231		#' variable_choices(ADSL, c("ARM", "ARMCD", "ACTARMCD")),
232		#' "ARM"
233		#' ),
234		#' y = choices_selected(
235		#' variable_choices(ADLB, c("AVAL", "BASE", "CHG", "PCHG")),
236		#' "AVAL"
237		#' ),
238		#' param = choices_selected(
239		#' value_choices(ADLB, "PARAMCD", "PARAM"),
240		#' "ALT"
241		#' )
242		#' )
243		#' )
244		#' )
245		#' if (interactive()) {
246		#' shinyApp(app$ui, app$server)
247		#' }
248		#'
249		#' @export
250		tm_g_lineplot <- function(label,
251		dataname,
252		parentname = ifelse(
253		inherits(strata, "data_extract_spec"),
254		teal.transform::datanames_input(strata),
255		"ADSL"
256		),
257		strata = teal.transform::choices_selected(
258		teal.transform::variable_choices(parentname, c("ARM", "ARMCD", "ACTARMCD")), "ARM"
259		),
260		x = teal.transform::choices_selected(
261		teal.transform::variable_choices(dataname, "AVISIT"), "AVISIT",
262		fixed = TRUE
263		),
264		y = teal.transform::choices_selected(
265		teal.transform::variable_choices(dataname, c("AVAL", "BASE", "CHG", "PCHG")), "AVAL"
266		),
267		y_unit = teal.transform::choices_selected(
268		teal.transform::variable_choices(dataname, "AVALU"), "AVALU",
269		fixed = TRUE
270		),
271		paramcd = teal.transform::choices_selected(
272		teal.transform::variable_choices(dataname, "PARAMCD"), "PARAMCD",
273		fixed = TRUE
274		),
275		param = teal.transform::choices_selected(
276		teal.transform::value_choices(dataname, "PARAMCD", "PARAM"), "ALT"
277		),
278		conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE),
279		interval = "mean_ci",
280		mid = "mean",
281		whiskers = c("mean_ci_lwr", "mean_ci_upr"),
282		table = c("n", "mean_sd", "median", "range"),
283		mid_type = "pl",
284		mid_point_size = c(2, 1, 5),
285		table_font_size = c(4, 2, 6),
286		plot_height = c(1000L, 200L, 4000L),
287		plot_width = NULL,
288		pre_output = NULL,
289		post_output = NULL,
290		ggplot2_args = teal.widgets::ggplot2_args()) {
291	!	message("Initializing tm_g_lineplot")
292	!	checkmate::assert_string(label)
293	!	checkmate::assert_string(dataname)
294	!	checkmate::assert_string(parentname)
295	!	checkmate::assert_string(mid)
296	!	checkmate::assert_string(interval, null.ok = TRUE)
297	!	whiskers <- match.arg(whiskers)
298	!	checkmate::assert_class(paramcd, "choices_selected")
299	!	checkmate::assert_class(conf_level, "choices_selected")
300	!	checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
301	!	checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
302	!	checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
303	!	checkmate::assert_numeric(
304	!	plot_width[1],
305	!	lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
306		)
307	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
308	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
309	!	checkmate::assert_class(ggplot2_args, "ggplot2_args")
310
311	!	args <- as.list(environment())
312	!	data_extract_list <- list(
313	!	strata = cs_to_des_select(strata, dataname = parentname),
314	!	param = cs_to_des_filter(param, dataname = dataname),
315	!	x = cs_to_des_select(x, dataname = dataname, multiple = FALSE),
316	!	y = cs_to_des_select(y, dataname = dataname, multiple = FALSE),
317	!	y_unit = cs_to_des_select(y_unit, dataname = dataname),
318	!	paramcd = cs_to_des_select(paramcd, dataname = dataname)
319		)
320
321	!	module(
322	!	label = label,
323	!	server = srv_g_lineplot,
324	!	ui = ui_g_lineplot,
325	!	ui_args = c(data_extract_list, args),
326	!	server_args = c(
327	!	data_extract_list,
328	!	list(
329	!	dataname = dataname,
330	!	label = label,
331	!	parentname = parentname,
332	!	plot_height = plot_height,
333	!	plot_width = plot_width,
334	!	ggplot2_args = ggplot2_args
335		)
336		),
337	!	datanames = teal.transform::get_extract_datanames(data_extract_list)
338		)
339		}
340
341		#' @keywords internal
342		ui_g_lineplot <- function(id, ...) {
343	!	a <- list(...)
344	!	is_single_dataset_value <- teal.transform::is_single_dataset(
345	!	a$strata,
346	!	a$paramcd,
347	!	a$x,
348	!	a$param,
349	!	a$y,
350	!	a$y_unit
351		)
352
353	!	ns <- NS(id)
354	!	teal.widgets::standard_layout(
355	!	output = teal.widgets::white_small_well(
356	!	verbatimTextOutput(outputId = ns("text")),
357	!	teal.widgets::plot_with_settings_ui(
358	!	id = ns("myplot")
359		)
360		),
361	!	encoding = tags$div(
362		### Reporter
363	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
364		###
365	!	tags$label("Encodings", class = "text-primary"),
366	!	teal.transform::datanames_input(a[c("strata", "paramcd", "x", "y", "y_unit", "param")]),
367	!	teal.transform::data_extract_ui(
368	!	id = ns("param"),
369	!	label = "Select Biomarker",
370	!	data_extract_spec = a$param,
371	!	is_single_dataset = is_single_dataset_value
372		),
373	!	teal.transform::data_extract_ui(
374	!	id = ns("strata"),
375	!	label = "Select Treatment Variable",
376	!	data_extract_spec = a$strata,
377	!	is_single_dataset = is_single_dataset_value
378		),
379	!	teal.transform::data_extract_ui(
380	!	id = ns("y"),
381	!	label = "Analysis Variable",
382	!	data_extract_spec = a$y,
383	!	is_single_dataset = is_single_dataset_value
384		),
385	!	teal.transform::data_extract_ui(
386	!	id = ns("x"),
387	!	label = "Time Variable",
388	!	data_extract_spec = a$x,
389	!	is_single_dataset = is_single_dataset_value
390		),
391	!	selectInput(
392	!	ns("mid"),
393	!	"Midpoint Statistic",
394	!	choices = c(
395	!	"Mean" = "mean",
396	!	"Median" = "median"
397		),
398	!	selected = "mean"
399		),
400	!	teal.widgets::optionalSelectInput(
401	!	ns("interval"),
402	!	"Interval",
403	!	choices = c(
404	!	"Mean CI" = "mean_ci",
405	!	"Median CI" = "median_ci",
406	!	"25% and 75%-ile" = "quantiles",
407	!	"Min - Max" = "range"
408		),
409	!	selected = "mean_ci"
410		),
411	!	checkboxInput(
412	!	ns("incl_screen"),
413	!	"Include screening visit",
414	!	value = TRUE
415		),
416	!	teal.widgets::panel_group(
417	!	teal.widgets::panel_item(
418	!	"Additional plot settings",
419	!	teal.widgets::optionalSelectInput(
420	!	ns("conf_level"),
421	!	"Level of Confidence",
422	!	a$conf_level$choices,
423	!	a$conf_level$selected,
424	!	multiple = FALSE,
425	!	fixed = a$conf_level$fixed
426		),
427	!	teal.widgets::optionalSliderInputValMinMax(
428	!	ns("mid_point_size"),
429	!	"Midpoint symbol size",
430	!	a$mid_point_size,
431	!	ticks = FALSE
432		),
433	!	checkboxGroupInput(
434	!	ns("whiskers"),
435	!	"Whiskers to display",
436	!	choices = c("Upper", "Lower"),
437	!	selected = c("Upper", "Lower")
438		),
439	!	radioButtons(
440	!	ns("mid_type"),
441	!	label = "Plot type",
442	!	choices = c(
443	!	"Point and line" = "pl",
444	!	"Point" = "p",
445	!	"Line" = "l"
446		),
447	!	selected = "pl"
448		),
449	!	teal.transform::data_extract_ui(
450	!	id = ns("y_unit"),
451	!	label = "Analysis Unit Variable",
452	!	data_extract_spec = a$y_unit,
453	!	is_single_dataset = is_single_dataset_value
454		),
455	!	teal.transform::data_extract_ui(
456	!	id = ns("paramcd"),
457	!	label = "Parameter Code Variable",
458	!	data_extract_spec = a$paramcd,
459	!	is_single_dataset = is_single_dataset_value
460		)
461		)
462		),
463	!	teal.widgets::panel_group(
464	!	teal.widgets::panel_item(
465	!	"Additional table settings",
466	!	teal.widgets::optionalSliderInputValMinMax(
467	!	ns("table_font_size"),
468	!	"Table Font Size",
469	!	a$table_font_size,
470	!	ticks = FALSE
471		),
472	!	checkboxGroupInput(
473	!	ns("table"),
474	!	label = "Choose the statistics to display in the table",
475	!	choices = c(
476	!	"n" = "n",
477	!	"Mean (SD)" = "mean_sd",
478	!	"Mean CI" = "mean_ci",
479	!	"Median" = "median",
480	!	"Median CI" = "median_ci",
481	!	"25% and 75%-ile" = "quantiles",
482	!	"Min - Max" = "range"
483		),
484	!	selected = a$table,
485		)
486		)
487		)
488		),
489	!	forms = tagList(
490	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
491		),
492	!	pre_output = a$pre_output,
493	!	post_output = a$post_output
494		)
495		}
496
497		#' @keywords internal
498		srv_g_lineplot <- function(id,
499		data,
500		reporter,
501		filter_panel_api,
502		dataname,
503		parentname,
504		paramcd,
505		strata,
506		x,
507		y,
508		param,
509		y_unit,
510		label,
511		plot_height,
512		plot_width,
513		ggplot2_args) {
514	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
515	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
516	!	checkmate::assert_class(data, "reactive")
517	!	checkmate::assert_class(isolate(data()), "teal_data")
518
519	!	moduleServer(id, function(input, output, session) {
520	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
521	!	selector_list <- teal.transform::data_extract_multiple_srv(
522	!	data_extract = list(x = x, y = y, strata = strata, paramcd = paramcd, y_unit = y_unit, param = param),
523	!	datasets = data,
524	!	select_validation_rule = list(
525	!	x = shinyvalidate::sv_required("Please select a time variable"),
526	!	y = shinyvalidate::sv_required("Please select an analysis variable"),
527	!	strata = shinyvalidate::sv_required("Please select a treatment variable")
528		),
529	!	filter_validation_rule = list(
530	!	param = shinyvalidate::sv_required(message = "Please select Biomarker filter.")
531		)
532		)
533
534	!	iv_r <- reactive({
535	!	iv <- shinyvalidate::InputValidator$new()
536	!	iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level"))
537	!	iv$add_rule(
538	!	"conf_level",
539	!	shinyvalidate::sv_between(
540	!	0, 1,
541	!	message_fmt = "Please choose a confidence level between 0 and 1", inclusive = c(FALSE, FALSE)
542		)
543		)
544	!	teal.transform::compose_and_enable_validators(iv, selector_list)
545		})
546
547	!	anl_inputs <- teal.transform::merge_expression_srv(
548	!	datasets = data,
549	!	selector_list = selector_list,
550	!	merge_function = "dplyr::inner_join"
551		)
552
553	!	anl_q <- reactive({
554	!	data() %>%
555	!	teal.code::eval_code(as.expression(anl_inputs()$expr))
556		})
557
558	!	merged <- list(anl_input_r = anl_inputs, anl_q = anl_q)
559
560	!	validate_checks <- reactive({
561	!	teal::validate_inputs(iv_r())
562
563	!	adsl_filtered <- merged$anl_q()[[parentname]]
564	!	anl_filtered <- merged$anl_q()[[dataname]]
565
566	!	input_strata <- names(merged$anl_input_r()$columns_source$strata)
567	!	input_x_var <- names(merged$anl_input_r()$columns_source$x)
568	!	input_y <- names(merged$anl_input_r()$columns_source$y)
569	!	input_param <- unlist(param$filter)["vars_selected"]
570	!	input_paramcd <- names(merged$anl_input_r()$columns_source$paramcd)
571	!	input_y_unit <- names(merged$anl_input_r()$columns_source$y_unit)
572
573		# validate inputs
574	!	validate_args <- list(
575	!	adsl = adsl_filtered,
576	!	adslvars = c("USUBJID", "STUDYID", input_strata),
577	!	anl = anl_filtered,
578	!	anlvars = c("USUBJID", "STUDYID", input_paramcd, input_x_var, input_y, input_y_unit, input_param),
579	!	arm_var = input_strata
580		)
581
582		# validate arm levels
583	!	if (length(input_strata) > 0 && length(unique(adsl_filtered[[input_strata]])) == 1) {
584	!	validate_args <- append(validate_args, list(min_n_levels_armvar = NULL))
585		}
586
587	!	do.call(what = "validate_standard_inputs", validate_args)
588	!	NULL
589		})
590
591	!	all_q <- reactive({
592	!	validate_checks()
593	!	ANL <- merged$anl_q()[["ANL"]]
594	!	teal::validate_has_data(ANL, 2)
595
596	!	whiskers_selected <- if ("Lower" %in% input$whiskers) 1 else NULL
597	!	if ("Upper" %in% input$whiskers) whiskers_selected <- c(whiskers_selected, 2)
598	!	if (is.null(input$interval) \|\| is.null(whiskers_selected)) {
599	!	input_whiskers <- NULL
600	!	input_interval <- NULL
601		} else {
602	!	input_interval <- input$interval
603	!	input_whiskers <- names(tern::s_summary(0)[[input_interval]][whiskers_selected])
604		}
605	!	input_param <- as.character(unique(ANL[[names(merged$anl_input_r()$columns_source$param)[1]]]))
606
607	!	my_calls <- template_g_lineplot(
608	!	dataname = "ANL",
609	!	strata = names(merged$anl_input_r()$columns_source$strata),
610	!	y = names(merged$anl_input_r()$columns_source$y),
611	!	x = names(merged$anl_input_r()$columns_source$x),
612	!	paramcd = names(merged$anl_input_r()$columns_source$paramcd),
613	!	y_unit = names(merged$anl_input_r()$columns_source$y_unit),
614	!	conf_level = as.numeric(input$conf_level),
615	!	incl_screen = input$incl_screen,
616	!	mid = input$mid,
617	!	interval = input_interval,
618	!	whiskers = input_whiskers,
619	!	table = input$table,
620	!	mid_type = input$mid_type,
621	!	mid_point_size = input$mid_point_size,
622	!	table_font_size = input$table_font_size,
623	!	ggplot2_args = ggplot2_args
624		)
625	!	teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
626		})
627
628	!	plot_r <- reactive(all_q()[["plot"]])
629
630		# Insert the plot into a plot with settings module from teal.widgets
631	!	pws <- teal.widgets::plot_with_settings_srv(
632	!	id = "myplot",
633	!	plot_r = plot_r,
634	!	height = plot_height,
635	!	width = plot_width
636		)
637
638	!	teal.widgets::verbatim_popup_srv(
639	!	id = "rcode",
640	!	verbatim_content = reactive(teal.code::get_code(all_q())),
641	!	title = label
642		)
643
644		### REPORTER
645	!	if (with_reporter) {
646	!	card_fun <- function(comment, label) {
647	!	card <- teal::report_card_template(
648	!	title = "Line Plot",
649	!	label = label,
650	!	with_filter = with_filter,
651	!	filter_panel_api = filter_panel_api
652		)
653	!	card$append_text("Plot", "header3")
654	!	card$append_plot(plot_r(), dim = pws$dim())
655	!	if (!comment == "") {
656	!	card$append_text("Comment", "header3")
657	!	card$append_text(comment)
658		}
659	!	card$append_src(teal.code::get_code(all_q()))
660	!	card
661		}
662	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
663		}
664		###
665		})
666		}

1		#' Template: Patient Profile Vitals Plot
2		#'
3		#' Creates a valid expression to generate a patient profile vitals [ggplot2::ggplot()] plot using ADaM datasets.
4		#'
5		#' @inheritParams template_arguments
6		#' @param paramcd_levels (`character`)\cr vector of all levels of `paramcd`.
7		#' @param xaxis (`character`)\cr name of the time variable to put on the x-axis.
8		#'
9		#' @inherit template_arguments return
10		#'
11		#' @seealso [tm_g_pp_vitals()]
12		#'
13		#' @keywords internal
14		template_vitals <- function(dataname = "ANL",
15		paramcd = "PARAMCD",
16		paramcd_levels = c("SYSBP", "DIABP", "PUL", "RESP", "OXYSAT", "WGHT", "TEMP"),
17		xaxis = "ADY",
18		aval = lifecycle::deprecated(),
19		aval_var = "AVAL",
20		patient_id,
21		font_size = 12L,
22		ggplot2_args = teal.widgets::ggplot2_args()) {
23	!	if (lifecycle::is_present(aval)) {
24	!	aval_var <- aval
25	!	warning(
26	!	"The `aval` argument of `template_vitals()` is deprecated as of teal.modules.clinical 0.8.16. ",
27	!	"Please use the `aval_var` argument instead.",
28	!	call. = FALSE
29		)
30		}
31
32	!	checkmate::assert_string(dataname)
33	!	checkmate::assert_string(paramcd)
34	!	checkmate::assert_string(xaxis)
35	!	checkmate::assert_string(aval_var)
36	!	checkmate::assert_string(patient_id)
37	!	checkmate::assert_number(font_size)
38
39		# Note: VSDY (study day of vital signs) was replaced with ADY (analysis day)
40	!	y <- list()
41	!	y$plot <- list()
42
43	!	parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args(
44	!	teal.widgets::resolve_ggplot2_args(
45	!	user_plot = ggplot2_args,
46	!	module_plot = teal.widgets::ggplot2_args(
47	!	labs = list(title = paste0("Patient ID: ", patient_id)),
48	!	theme = list(
49	!	text = substitute(ggplot2::element_text(size = font), list(font = font_size)),
50	!	axis.text.y = quote(ggplot2::element_blank()),
51	!	axis.ticks.y = quote(ggplot2::element_blank()),
52	!	plot.title = substitute(ggplot2::element_text(size = font), list(font = font_size)),
53	!	legend.position = "top",
54	!	panel.grid.minor = quote(ggplot2::element_line(
55	!	linewidth = 0.5,
56	!	linetype = "dotted",
57	!	colour = "grey"
58		)),
59	!	panel.grid.major = quote(ggplot2::element_line(
60	!	linewidth = 0.5,
61	!	linetype = "dotted",
62	!	colour = "grey"
63		))
64		)
65		)
66		),
67	!	ggtheme = "minimal"
68		)
69
70	!	vital_plot <- add_expr(
71	!	list(),
72	!	substitute_names(
73	!	names = list(
74	!	dataname = as.name(dataname),
75	!	paramcd = as.name(paramcd),
76	!	xaxis = as.name(xaxis),
77	!	aval_var = as.name(aval_var)
78		),
79	!	others = list(paramcd_levels = paramcd_levels),
80	!	expr = {
81	!	vitals <-
82	!	dataname %>%
83	!	dplyr::group_by(paramcd, xaxis) %>%
84	!	dplyr::filter(paramcd %in% paramcd_levels) %>%
85	!	dplyr::summarise(aval_var = max(aval_var, na.rm = TRUE)) %>%
86	!	dplyr::mutate(
87	!	aval_var = ifelse(is.infinite(aval_var), NA, aval_var),
88	!	xaxis = as.numeric(xaxis) # difftime fails ggplot2::scale_x_continuous
89		)
90		}
91		)
92		)
93
94	!	vital_plot <- add_expr(
95	!	vital_plot,
96	!	substitute(
97	!	expr = {
98	!	max_day <- max(vitals[[xaxis_char]], na.rm = TRUE)
99	!	max_aval <- max(vitals[[aval_char]], na.rm = TRUE)
100	!	max_aval_seq <- seq(0, max_aval, 10)
101
102	!	full_vita <- levels(dataname[[paramcd_char]])
103	!	provided_vita <- paramcd_levels
104	!	known_vita <- c("SYSBP", "DIABP", "TEMP", "RESP", "OXYSAT", "PULSE")
105
106	!	paramcd_levels_e <- known_vita[stats::na.omit(match(provided_vita, known_vita))]
107	!	len_paramcd_levels_e <- length(paramcd_levels_e)
108
109	!	all_colors <- stats::setNames(nestcolor::color_palette(length(full_vita), "stream"), full_vita)
110	!	vars_colors <- all_colors[provided_vita]
111	!	names(vars_colors) <- provided_vita
112
113	!	base_stats <- stats::setNames(c(140, 90, 38, 20, 94, 100), known_vita)
114	!	paramcd_stats_e <- base_stats[paramcd_levels_e]
115
116	!	base_labels <- stats::setNames(c("140mmHg", "90mmHg", "38\u00B0 C", "20/min", "94%", "100bpm"), known_vita)
117	!	paramcd_labels_e <- base_labels[paramcd_levels_e]
118
119	!	base_stats_df <- data.frame(
120	!	x = rep(1, len_paramcd_levels_e),
121	!	y = paramcd_stats_e,
122	!	label = paramcd_labels_e,
123	!	color = paramcd_levels_e
124		)
125
126	!	result_plot <- ggplot2::ggplot(data = vitals, mapping = ggplot2::aes(x = xaxis)) + # replaced VSDY
127	!	ggplot2::geom_line(
128	!	data = vitals,
129	!	mapping = ggplot2::aes(y = aval_var, color = paramcd),
130	!	size = 1.5,
131	!	alpha = 0.5
132		) +
133	!	ggplot2::scale_color_manual(
134	!	values = vars_colors
135		) +
136	!	ggplot2::geom_text(
137	!	data = base_stats_df,
138	!	ggplot2::aes(x = x, y = y, label = label, color = color),
139	!	alpha = 1,
140	!	nudge_y = 2.2,
141	!	size = font_size_var / 3.5,
142	!	show.legend = FALSE
143		) +
144	!	ggplot2::geom_hline(
145	!	data = base_stats_df,
146	!	ggplot2::aes(yintercept = y, color = color),
147	!	linetype = 2,
148	!	alpha = 0.5,
149	!	size = 1,
150	!	show.legend = FALSE
151		) +
152	!	ggplot2::scale_y_continuous(
153	!	breaks = seq(0, max(vitals[[xaxis_char]], na.rm = TRUE), 50),
154	!	minor_breaks = seq(0, max(vitals[[aval_char]], na.rm = TRUE), 10)
155		) +
156	!	ggplot2::geom_text(
157	!	data = data.frame(
158	!	x = rep(max_day, length(max_aval_seq)),
159	!	y = max_aval_seq,
160	!	l = as.character(max_aval_seq)
161		),
162	!	ggplot2::aes(
163	!	x = x,
164	!	y = y,
165	!	label = l
166		),
167	!	color = "black",
168	!	alpha = 1,
169	!	nudge_y = 2.2,
170	!	size = font_size_var / 3.5
171		) +
172	!	labs +
173	!	ggthemes +
174	!	themes
175
176	!	print(result_plot)
177		},
178	!	env = list(
179	!	dataname = as.name(dataname),
180	!	paramcd = as.name(paramcd),
181	!	paramcd_char = paramcd,
182	!	paramcd_levels = paramcd_levels,
183	!	xaxis = as.name(xaxis),
184	!	xaxis_char = xaxis,
185	!	aval_var = as.name(aval_var),
186	!	aval_char = aval_var,
187	!	patient_id = patient_id,
188	!	font_size_var = font_size,
189	!	labs = parsed_ggplot2_args$labs,
190	!	ggthemes = parsed_ggplot2_args$ggtheme,
191	!	themes = parsed_ggplot2_args$theme
192		)
193		)
194		)
195
196	!	y$plot <- bracket_expr(vital_plot)
197	!	y
198		}
199
200		#' teal Module: Patient Profile Vitals Plot
201		#'
202		#' This module produces a patient profile vitals [ggplot2::ggplot()] type plot using ADaM datasets.
203		#'
204		#' This plot supports horizontal lines for the following 6 `PARAMCD` levels when they are present in `dataname`:
205		#' `"SYSBP"`, `"DIABP"`, `"TEMP"`, `"RESP"`, `"OXYSAT"`.
206		#'
207		#' @inheritParams module_arguments
208		#' @inheritParams template_vitals
209		#' @param xaxis ([teal.transform::choices_selected()])\cr object with all
210		#' available choices and preselected option for the time variable from `dataname` to be put on the plot x-axis.
211		#'
212		#' @inherit module_arguments return
213		#'
214		#' @examples
215		#' library(nestcolor)
216		#'
217		#' ADSL <- tmc_ex_adsl
218		#' ADVS <- tmc_ex_advs
219		#'
220		#' app <- init(
221		#' data = cdisc_data(
222		#' ADSL = ADSL,
223		#' ADVS = ADVS,
224		#' code = "
225		#' ADSL <- tmc_ex_adsl
226		#' ADVS <- tmc_ex_advs
227		#' "
228		#' ),
229		#' modules = modules(
230		#' tm_g_pp_vitals(
231		#' label = "Vitals",
232		#' dataname = "ADVS",
233		#' parentname = "ADSL",
234		#' patient_col = "USUBJID",
235		#' plot_height = c(600L, 200L, 2000L),
236		#' paramcd = choices_selected(
237		#' choices = variable_choices(ADVS, "PARAMCD"),
238		#' selected = "PARAMCD"
239		#' ),
240		#' xaxis = choices_selected(
241		#' choices = variable_choices(ADVS, "ADY"),
242		#' selected = "ADY"
243		#' ),
244		#' aval_var = choices_selected(
245		#' choices = variable_choices(ADVS, "AVAL"),
246		#' selected = "AVAL"
247		#' )
248		#' )
249		#' )
250		#' )
251		#' if (interactive()) {
252		#' shinyApp(app$ui, app$server)
253		#' }
254		#'
255		#' @export
256		tm_g_pp_vitals <- function(label,
257		dataname = "ADVS",
258		parentname = "ADSL",
259		patient_col = "USUBJID",
260		paramcd = NULL,
261		aval = lifecycle::deprecated(),
262		aval_var = NULL,
263		xaxis = NULL,
264		font_size = c(12L, 12L, 25L),
265		plot_height = c(700L, 200L, 2000L),
266		plot_width = NULL,
267		pre_output = NULL,
268		post_output = NULL,
269		ggplot2_args = teal.widgets::ggplot2_args()) {
270	!	if (lifecycle::is_present(aval)) {
271	!	aval_var <- aval
272	!	warning(
273	!	"The `aval` argument of `tm_g_pp_vitals()` is deprecated as of teal.modules.clinical 0.8.16. ",
274	!	"Please use the `aval_var` argument instead.",
275	!	call. = FALSE
276		)
277		} else {
278	!	aval <- aval_var # resolves missing argument error
279		}
280
281	!	message("Initializing tm_g_pp_vitals")
282	!	checkmate::assert_string(label)
283	!	checkmate::assert_string(dataname)
284	!	checkmate::assert_string(parentname)
285	!	checkmate::assert_string(patient_col)
286	!	checkmate::assert_class(paramcd, "choices_selected", null.ok = TRUE)
287	!	checkmate::assert_class(aval_var, "choices_selected", null.ok = TRUE)
288	!	checkmate::assert_class(xaxis, "choices_selected", null.ok = TRUE)
289	!	checkmate::assert_numeric(font_size, len = 3, any.missing = FALSE, finite = TRUE)
290	!	checkmate::assert_numeric(font_size[1], lower = font_size[2], upper = font_size[3], .var.name = "font_size")
291	!	checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
292	!	checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
293	!	checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
294	!	checkmate::assert_numeric(
295	!	plot_width[1],
296	!	lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
297		)
298	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
299	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
300	!	checkmate::assert_class(ggplot2_args, "ggplot2_args")
301	!	checkmate::assert_multi_class(paramcd, c("choices_selected", "data_extract_spec"), null.ok = TRUE)
302	!	checkmate::assert_multi_class(aval_var, c("choices_selected", "data_extract_spec"), null.ok = TRUE)
303	!	checkmate::assert_multi_class(xaxis, c("choices_selected", "data_extract_spec"), null.ok = TRUE)
304
305	!	args <- as.list(environment())
306	!	data_extract_list <- list(
307	!	paramcd = `if`(is.null(paramcd), NULL, cs_to_des_select(paramcd, dataname = dataname)),
308	!	aval_var = `if`(is.null(aval_var), NULL, cs_to_des_select(aval_var, dataname = dataname)),
309	!	xaxis = `if`(is.null(xaxis), NULL, cs_to_des_select(xaxis, dataname = dataname))
310		)
311
312	!	module(
313	!	label = label,
314	!	ui = ui_g_vitals,
315	!	ui_args = c(data_extract_list, args),
316	!	server = srv_g_vitals,
317	!	server_args = c(
318	!	data_extract_list,
319	!	list(
320	!	dataname = dataname,
321	!	parentname = parentname,
322	!	label = label,
323	!	patient_col = patient_col,
324	!	plot_height = plot_height,
325	!	plot_width = plot_width,
326	!	ggplot2_args = ggplot2_args
327		)
328		),
329	!	datanames = c(dataname, parentname)
330		)
331		}
332
333		#' @keywords internal
334		ui_g_vitals <- function(id, ...) {
335	!	ui_args <- list(...)
336	!	is_single_dataset_value <- teal.transform::is_single_dataset(
337	!	ui_args$paramcd,
338	!	ui_args$aval_var,
339	!	ui_args$xaxis
340		)
341
342	!	ns <- NS(id)
343	!	teal.widgets::standard_layout(
344	!	output = teal.widgets::plot_with_settings_ui(id = ns("vitals_plot")),
345	!	encoding = tags$div(
346		### Reporter
347	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
348		###
349	!	tags$label("Encodings", class = "text-primary"),
350	!	teal.transform::datanames_input(ui_args[c("paramcd", "aval_var", "xaxis")]),
351	!	teal.widgets::optionalSelectInput(
352	!	ns("patient_id"),
353	!	"Select Patient:",
354	!	multiple = FALSE,
355	!	options = shinyWidgets::pickerOptions(`liveSearch` = TRUE)
356		),
357	!	teal.transform::data_extract_ui(
358	!	id = ns("paramcd"),
359	!	label = "Select PARAMCD variable:",
360	!	data_extract_spec = ui_args$paramcd,
361	!	is_single_dataset = is_single_dataset_value
362		),
363	!	uiOutput(ns("paramcd_levels")),
364	!	teal.transform::data_extract_ui(
365	!	id = ns("xaxis"),
366	!	label = "Select vital plot x-axis:",
367	!	data_extract_spec = ui_args$xaxis,
368	!	is_single_dataset = is_single_dataset_value
369		),
370	!	teal.transform::data_extract_ui(
371	!	id = ns("aval_var"),
372	!	label = "Select AVAL variable:",
373	!	data_extract_spec = ui_args$aval_var,
374	!	is_single_dataset = is_single_dataset_value
375		),
376	!	teal.widgets::panel_item(
377	!	title = "Plot settings",
378	!	collapsed = TRUE,
379	!	teal.widgets::optionalSliderInputValMinMax(
380	!	ns("font_size"), "Font Size", ui_args$font_size,
381	!	ticks = FALSE, step = 1
382		)
383		)
384		),
385	!	forms = tagList(
386	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
387		),
388	!	pre_output = ui_args$pre_output,
389	!	post_output = ui_args$post_output
390		)
391		}
392
393		#' @keywords internal
394		srv_g_vitals <- function(id,
395		data,
396		reporter,
397		filter_panel_api,
398		dataname,
399		parentname,
400		patient_col,
401		paramcd,
402		aval_var,
403		xaxis,
404		plot_height,
405		plot_width,
406		label,
407		ggplot2_args) {
408	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
409	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
410	!	checkmate::assert_class(data, "reactive")
411	!	checkmate::assert_class(isolate(data()), "teal_data")
412
413	!	moduleServer(id, function(input, output, session) {
414	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
415	!	patient_id <- reactive(input$patient_id)
416
417		# Init
418	!	patient_data_base <- reactive(unique(data()[[parentname]][[patient_col]]))
419	!	teal.widgets::updateOptionalSelectInput(
420	!	session,
421	!	"patient_id",
422	!	choices = patient_data_base(),
423	!	selected = patient_data_base()[1]
424		)
425
426	!	observeEvent(patient_data_base(),
427	!	handlerExpr = {
428	!	teal.widgets::updateOptionalSelectInput(
429	!	session,
430	!	"patient_id",
431	!	choices = patient_data_base(),
432	!	selected = if (length(patient_data_base()) == 1) {
433	!	patient_data_base()
434		} else {
435	!	intersect(patient_id(), patient_data_base())
436		}
437		)
438		},
439	!	ignoreInit = TRUE
440		)
441
442		# Vitals tab ----
443
444	!	selector_list <- teal.transform::data_extract_multiple_srv(
445	!	data_extract = list(paramcd = paramcd, xaxis = xaxis, aval_var = aval_var),
446	!	datasets = data,
447	!	select_validation_rule = list(
448	!	paramcd = shinyvalidate::sv_required(
449	!	"Please select PARAMCD variable."
450		),
451	!	xaxis = shinyvalidate::sv_required(
452	!	"Please select Vitals x-axis variable."
453		),
454	!	aval_var = shinyvalidate::sv_required(
455	!	"Please select AVAL variable."
456		)
457		)
458		)
459
460	!	iv_r <- reactive({
461	!	iv <- shinyvalidate::InputValidator$new()
462	!	iv$add_rule("patient_id", shinyvalidate::sv_required(
463	!	"Please select a patient."
464		))
465	!	iv$add_rule("paramcd_levels_vals", shinyvalidate::sv_required(
466	!	"Please select PARAMCD variable levels."
467		))
468	!	teal.transform::compose_and_enable_validators(iv, selector_list)
469		})
470
471	!	anl_inputs <- teal.transform::merge_expression_srv(
472	!	datasets = data,
473	!	selector_list = selector_list,
474	!	merge_function = "dplyr::left_join"
475		)
476
477	!	anl_q <- reactive({
478	!	data() %>%
479	!	teal.code::eval_code(as.expression(anl_inputs()$expr))
480		})
481
482	!	merged <- list(anl_input_r = anl_inputs, anl_q = anl_q)
483
484	!	output$paramcd_levels <- renderUI({
485	!	paramcd_var <- input[[extract_input("paramcd", dataname)]]
486
487	!	req(paramcd_var)
488	!	req(input$patient_id)
489
490	!	vitals_dat <- merged$anl_q()[["ANL"]]
491	!	vitals_dat_sub <- vitals_dat[vitals_dat[[patient_col]] == patient_id(), ]
492	!	paramcd_col <- vitals_dat_sub[[paramcd_var]]
493	!	paramcd_col_levels <- unique(paramcd_col)
494
495	!	cur_selected <- isolate(input$paramcd_levels_vals)
496
497	!	selected <- if (length(cur_selected) > 0) {
498	!	cur_selected
499		} else {
500	!	paramcd_col_levels
501		}
502
503	!	tagList(
504	!	selectInput(
505	!	session$ns("paramcd_levels_vals"),
506	!	"Select PARAMCD variable levels:",
507	!	selected = selected,
508	!	choices = paramcd_col_levels,
509	!	multiple = TRUE
510		)
511		)
512		})
513
514	!	all_q <- reactive({
515	!	teal::validate_has_data(merged$anl_q()[["ANL"]], 1)
516
517	!	teal::validate_inputs(iv_r())
518
519	!	validate(
520	!	need(
521	!	nrow(merged$anl_q()[["ANL"]][input$patient_id == merged$anl_q()[["ANL"]][, patient_col], ]) > 0,
522	!	"Selected patient is not in dataset (either due to filtering or missing values). Consider relaxing filters."
523		)
524		)
525
526	!	my_calls <- template_vitals(
527	!	dataname = "ANL",
528	!	paramcd = input[[extract_input("paramcd", dataname)]],
529	!	paramcd_levels = input[["paramcd_levels_vals"]],
530	!	xaxis = input[[extract_input("xaxis", dataname)]],
531	!	aval_var = input[[extract_input("aval_var", dataname)]],
532	!	patient_id = patient_id(),
533	!	font_size = input[["font_size"]],
534	!	ggplot2_args = ggplot2_args
535		)
536
537	!	teal.code::eval_code(
538	!	merged$anl_q(),
539	!	substitute(
540	!	expr = {
541	!	ANL <- ANL[ANL[[patient_col]] == patient_id, ]
542	!	}, env = list(
543	!	patient_col = patient_col,
544	!	patient_id = patient_id()
545		)
546		)
547		) %>%
548	!	teal.code::eval_code(as.expression(my_calls))
549		})
550
551	!	plot_r <- reactive(all_q()[["result_plot"]])
552
553	!	pws <- teal.widgets::plot_with_settings_srv(
554	!	id = "vitals_plot",
555	!	plot_r = plot_r,
556	!	height = plot_height,
557	!	width = plot_width
558		)
559
560	!	teal.widgets::verbatim_popup_srv(
561	!	id = "rcode",
562	!	verbatim_content = reactive(teal.code::get_code(all_q())),
563	!	title = label
564		)
565
566		### REPORTER
567	!	if (with_reporter) {
568	!	card_fun <- function(comment, label) {
569	!	card <- teal::report_card_template(
570	!	title = "Patient Profile Vitals Plot",
571	!	label = label,
572	!	with_filter = with_filter,
573	!	filter_panel_api = filter_panel_api
574		)
575	!	card$append_text("Plot", "header3")
576	!	card$append_plot(plot_r(), dim = pws$dim())
577	!	if (!comment == "") {
578	!	card$append_text("Comment", "header3")
579	!	card$append_text(comment)
580		}
581	!	card$append_src(teal.code::get_code(all_q()))
582	!	card
583		}
584	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
585		}
586		###
587		})
588		}

1		#' Template: Exposure Table for Risk management plan
2		#'
3		#' Creates a valid expression to generate exposure table for risk management plan.
4		#'
5		#' @inheritParams template_arguments
6		#' @param row_by_var (`character`)\cr variable name used to split the values by rows.
7		#' @param col_by_var (`character`)\cr variable name used to split the values by columns.
8		#' @param drop_levels (`flag`)\cr whether empty rows should be removed from the table.
9		#' @param paramcd_label (`character`)\cr the column from the `dataname` dataset where the
10		#' value will be used to label the argument `paramcd`.
11		#' @param add_total_row (`flag`)\cr whether a "total" level should be added after the others which includes all the
12		#' levels that constitute the split. A custom label can be set for this level via the `total_row_label` argument.
13		#' @param total_row_label (`character`)\cr string to display as total row label if row is
14		#' enabled (see `add_total_row`).
15		#'
16		#' @inherit template_arguments return
17		#'
18		#' @seealso [tm_t_exposure()]
19		#'
20		#' @keywords internal
21		template_exposure <- function(parentname,
22		dataname,
23		id_var,
24		paramcd,
25		paramcd_label = NULL,
26		row_by_var,
27		col_by_var = NULL,
28		add_total = FALSE,
29		total_label = "Total",
30		add_total_row = TRUE,
31		total_row_label = "Total number of patients and patient time*",
32		drop_levels = TRUE,
33		na_level = default_na_str(),
34		aval_var,
35		avalu_var,
36		basic_table_args = teal.widgets::basic_table_args()) {
37	3x	checkmate::assert_string(dataname)
38	3x	checkmate::assert_string(parentname)
39	3x	checkmate::assert_string(row_by_var)
40	3x	checkmate::assert_character(col_by_var, null.ok = TRUE)
41	3x	checkmate::assert_string(paramcd)
42	3x	checkmate::assert_string(id_var)
43	3x	checkmate::assert_flag(add_total)
44	3x	checkmate::assert_string(total_label)
45	3x	checkmate::assert_flag(add_total_row)
46	3x	checkmate::assert_string(total_row_label)
47	3x	checkmate::assert_string(na_level)
48	3x	checkmate::assert_string(aval_var)
49	3x	checkmate::assert_string(avalu_var, null.ok = TRUE)
50	3x	checkmate::assert_flag(drop_levels)
51
52	3x	y <- list()
53	3x	data_list <- list()
54
55	3x	if (length(col_by_var) == 0) {
56	!	col_by_var <- NULL
57		}
58
59	3x	data_list <- add_expr(
60	3x	data_list,
61	3x	substitute(
62	3x	anl <- dataname,
63	3x	env = list(
64	3x	dataname = as.name(dataname)
65		)
66		)
67		)
68
69	3x	data_list <- add_expr(
70	3x	data_list,
71	3x	substitute(
72	3x	dataname <- df_explicit_na(dataname, na_level = na_str),
73	3x	env = list(
74	3x	dataname = as.name("anl"),
75	3x	na_str = na_level
76		)
77		)
78		)
79	3x	y$data <- bracket_expr(data_list)
80
81		# layout start
82	3x	y$layout_prep <- quote(split_fun <- drop_split_levels)
83
84	3x	if (is.null(paramcd_label)) {
85	2x	paramcd_label <- paramcd
86		}
87
88	3x	parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
89	3x	teal.widgets::resolve_basic_table_args(
90	3x	user_table = basic_table_args,
91	3x	module_table = teal.widgets::basic_table_args(
92	3x	show_colcounts = TRUE,
93	3x	main_footer = paste0("* Patient time is the sum of ", paramcd_label)
94		)
95		)
96		)
97
98	3x	layout_list <- list()
99	3x	layout_list <- add_expr(
100	3x	layout_list,
101	3x	parsed_basic_table_args
102		)
103
104	3x	if (length(col_by_var) > 0) {
105	3x	if (add_total) {
106	!	layout_list <- add_expr(
107	!	layout_list,
108	!	substitute(
109	!	rtables::split_cols_by(col_by_var, split_fun = add_overall_level(total_label, first = FALSE)),
110	!	env = list(
111	!	col_by_var = col_by_var,
112	!	total_label = total_label
113		)
114		)
115		)
116		} else {
117	3x	layout_list <- add_expr(
118	3x	layout_list,
119	3x	substitute(
120	3x	rtables::split_cols_by(col_by_var),
121	3x	env = list(
122	3x	col_by_var = col_by_var
123		)
124		)
125		)
126		}
127		}
128
129	3x	layout_list <- add_expr(
130	3x	layout_list,
131	3x	substitute(
132	3x	analyze_patients_exposure_in_cols(
133	3x	var = row_by_var,
134	3x	ex_var = aval_var,
135	3x	col_split = TRUE,
136	3x	add_total_level = add_total_row,
137	3x	na_str = na_str,
138	3x	.labels = c(
139	3x	n_patients = "Number of Patients",
140	3x	sum_exposure = ifelse(
141	3x	avalu_var == " ",
142	3x	paste("Sum of", paramcd),
143	3x	paste("Sum of", paramcd, sprintf("(%s)", avalu_var))
144		)
145		),
146	3x	custom_label = total_row_label
147		),
148	3x	env = list(
149	3x	row_by_var = row_by_var,
150	3x	aval_var = aval_var,
151	3x	add_total_row = add_total_row,
152	3x	na_str = na_level,
153	3x	avalu_var = avalu_var,
154	3x	paramcd = paramcd,
155	3x	total_row_label = total_row_label
156		)
157		)
158		)
159
160	3x	split_label <- substitute(
161	3x	expr = teal.data::col_labels(dataname[row_by_var], fill = TRUE),
162	3x	env = list(
163	3x	dataname = as.name(dataname),
164	3x	row_by_var = row_by_var
165		)
166		)
167
168	3x	layout_list <- add_expr(
169	3x	layout_list,
170	3x	substitute(
171	3x	analyze_patients_exposure_in_cols(
172	3x	var = row_by_var,
173	3x	col_split = FALSE,
174	3x	na_str = na_str
175		) %>%
176	3x	append_topleft(c(split_label)),
177	3x	env = list(
178	3x	row_by_var = row_by_var,
179	3x	na_str = na_level,
180	3x	split_label = split_label
181		)
182		)
183		)
184
185	3x	y$layout <- substitute(
186	3x	expr = lyt <- layout_pipe,
187	3x	env = list(layout_pipe = pipe_expr(layout_list))
188		)
189
190	3x	y$table <- substitute(
191	3x	expr = {
192	!	result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
193	!	result
194		},
195	3x	env = list(parent = as.name(parentname))
196		)
197
198	3x	if (drop_levels) {
199	3x	y$table <- substitute(
200	3x	expr = {
201	!	result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
202	!	rtables::prune_table(result)
203		},
204	3x	env = list(parent = as.name(parentname))
205		)
206		}
207	3x	y
208		}
209
210		#' teal Module: Exposure Table for Risk management plan
211		#'
212		#' The module produces an exposure table for risk management plan.
213		#'
214		#' @inheritParams module_arguments
215		#' @inheritParams template_exposure
216		#' @param row_by_var ([teal.transform::choices_selected()])\cr
217		#' object with all available choices and preselected option for
218		#' variable names that can be used to split rows.
219		#' @param col_by_var ([teal.transform::choices_selected()])\cr
220		#' object with all available choices and preselected option for
221		#' variable names that can be used to split columns.
222		#' @param parcat ([teal.transform::choices_selected()])\cr
223		#' object with all available choices and preselected option for
224		#' parameter category values.
225		#' @param paramcd_label (`character`)\cr the column from the dataset where the value will be used to
226		#' label the argument `paramcd`.
227		#'
228		#' @inherit module_arguments return seealso
229		#'
230		#' @examples
231		#' library(dplyr)
232		#'
233		#' data <- teal_data()
234		#' data <- within(data, {
235		#' ADSL <- tmc_ex_adsl
236		#' ADEX <- tmc_ex_adex
237		#'
238		#' set.seed(1, kind = "Mersenne-Twister")
239		#' labels <- col_labels(ADEX, fill = FALSE)
240		#' ADEX <- ADEX %>%
241		#' distinct(USUBJID, .keep_all = TRUE) %>%
242		#' mutate(
243		#' PARAMCD = "TDURD",
244		#' PARAM = "Overall duration (days)",
245		#' AVAL = sample(x = seq(1, 200), size = n(), replace = TRUE),
246		#' AVALU = "Days"
247		#' ) %>%
248		#' bind_rows(ADEX)
249		#' col_labels(ADEX) <- labels
250		#' })
251		#'
252		#' datanames <- c("ADSL", "ADEX")
253		#' datanames(data) <- datanames
254		#' join_keys(data) <- default_cdisc_join_keys[datanames]
255		#'
256		#' app <- init(
257		#' data = data,
258		#' modules = modules(
259		#' tm_t_exposure(
260		#' label = "Duration of Exposure Table",
261		#' dataname = "ADEX",
262		#' paramcd = choices_selected(
263		#' choices = value_choices(data[["ADEX"]], "PARAMCD", "PARAM"),
264		#' selected = "TDURD"
265		#' ),
266		#' col_by_var = choices_selected(
267		#' choices = variable_choices(data[["ADEX"]], subset = c("SEX", "ARM")),
268		#' selected = "SEX"
269		#' ),
270		#' row_by_var = choices_selected(
271		#' choices = variable_choices(data[["ADEX"]], subset = c("RACE", "REGION1", "STRATA1", "SEX")),
272		#' selected = "RACE"
273		#' ),
274		#' parcat = choices_selected(
275		#' choices = value_choices(data[["ADEX"]], "PARCAT2"),
276		#' selected = "Drug A"
277		#' ),
278		#' add_total = FALSE
279		#' )
280		#' ),
281		#' filter = teal_slices(teal_slice("ADSL", "SAFFL", selected = "Y"))
282		#' )
283		#' if (interactive()) {
284		#' shinyApp(app$ui, app$server)
285		#' }
286		#'
287		#' @export
288		tm_t_exposure <- function(label,
289		dataname,
290		parentname = ifelse(
291		inherits(col_by_var, "data_extract_spec"),
292		teal.transform::datanames_input(col_by_var),
293		"ADSL"
294		),
295		row_by_var,
296		col_by_var,
297		paramcd = teal.transform::choices_selected(
298		choices = teal.transform::value_choices(dataname, "PARAMCD", "PARAM"),
299		selected = "TDURD"
300		),
301		paramcd_label = "PARAM",
302		id_var = teal.transform::choices_selected(
303		teal.transform::variable_choices(dataname, subset = "USUBJID"),
304		selected = "USUBJID",
305		fixed = TRUE
306		),
307		parcat,
308		aval_var = teal.transform::choices_selected(
309		teal.transform::variable_choices(dataname, subset = "AVAL"),
310		selected = "AVAL",
311		fixed = TRUE
312		),
313		avalu_var = teal.transform::choices_selected(
314		teal.transform::variable_choices(dataname, subset = "AVALU"),
315		selected = "AVALU",
316		fixed = TRUE
317		),
318		add_total,
319		total_label = default_total_label(),
320		add_total_row = TRUE,
321		total_row_label = "Total number of patients and patient time*",
322		na_level = default_na_str(),
323		pre_output = NULL,
324		post_output = NULL,
325		basic_table_args = teal.widgets::basic_table_args()) {
326	!	message("Initializing tm_t_exposure")
327	!	checkmate::assert_string(label)
328	!	checkmate::assert_string(dataname)
329	!	checkmate::assert_string(parentname)
330	!	checkmate::assert_string(na_level)
331	!	checkmate::assert_class(row_by_var, "choices_selected")
332	!	checkmate::assert_class(col_by_var, "choices_selected")
333	!	checkmate::assert_class(paramcd, "choices_selected")
334	!	checkmate::assert_class(id_var, "choices_selected")
335	!	checkmate::assert_class(parcat, "choices_selected")
336	!	checkmate::assert_class(aval_var, "choices_selected")
337	!	checkmate::assert_class(avalu_var, "choices_selected")
338	!	checkmate::assert_flag(add_total)
339	!	checkmate::assert_string(total_label)
340	!	checkmate::assert_flag(add_total_row)
341	!	checkmate::assert_string(total_row_label)
342	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
343	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
344	!	checkmate::assert_class(basic_table_args, "basic_table_args")
345
346	!	data_extract_list <- list(
347	!	paramcd = cs_to_des_filter(paramcd, dataname = dataname),
348	!	row_by_var = cs_to_des_select(row_by_var, dataname = dataname),
349	!	col_by_var = cs_to_des_select(col_by_var, dataname = parentname),
350	!	id_var = cs_to_des_select(id_var, dataname = dataname),
351	!	parcat = cs_to_des_filter(parcat, dataname = dataname),
352	!	aval_var = cs_to_des_select(aval_var, dataname = dataname),
353	!	avalu_var = cs_to_des_select(avalu_var, dataname = dataname)
354		)
355
356	!	args <- as.list(environment())
357	!	module(
358	!	label = label,
359	!	ui = ui_t_exposure,
360	!	server = srv_t_exposure,
361	!	ui_args = c(data_extract_list, args),
362	!	server_args = c(
363	!	data_extract_list,
364	!	list(
365	!	dataname = dataname,
366	!	parentname = parentname,
367	!	label = label,
368	!	total_label = total_label,
369	!	total_row_label = total_row_label,
370	!	na_level = na_level,
371	!	basic_table_args = basic_table_args,
372	!	paramcd_label = paramcd_label
373		)
374		),
375	!	datanames = teal.transform::get_extract_datanames(data_extract_list)
376		)
377		}
378
379
380		#' @keywords internal
381		ui_t_exposure <- function(id, ...) {
382	!	ns <- NS(id)
383	!	a <- list(...) # module args
384
385	!	is_single_dataset_value <- teal.transform::is_single_dataset(
386	!	a$paramcd,
387	!	a$col_by_var,
388	!	a$row_by_var,
389	!	a$id_var,
390	!	a$parcat,
391	!	a$aval_var,
392	!	a$avalu_var
393		)
394
395	!	teal.widgets::standard_layout(
396	!	output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
397	!	encoding = tags$div(
398		### Reporter
399	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
400		###
401	!	tags$label("Encodings", class = "text-primary"),
402	!	teal.transform::datanames_input(a[c(
403	!	"paramcd", "col_by_var", "row_by_var", "id_var", "parcat", "aval_var", "avalu_var"
404		)]),
405	!	teal.transform::data_extract_ui(
406	!	id = ns("paramcd"),
407	!	label = "Select the Parameter",
408	!	data_extract_spec = a$paramcd,
409	!	is_single_dataset = is_single_dataset_value
410		),
411	!	teal.transform::data_extract_ui(
412	!	id = ns("parcat"),
413	!	label = "Select the Parameter Category",
414	!	data_extract_spec = a$parcat,
415	!	is_single_dataset = is_single_dataset_value
416		),
417	!	teal.transform::data_extract_ui(
418	!	id = ns("col_by_var"),
419	!	label = "Select Column by Variable",
420	!	data_extract_spec = a$col_by_var,
421	!	is_single_dataset = is_single_dataset_value
422		),
423	!	teal.transform::data_extract_ui(
424	!	id = ns("row_by_var"),
425	!	label = "Select Row by Variable",
426	!	data_extract_spec = a$row_by_var,
427	!	is_single_dataset = is_single_dataset_value
428		),
429	!	checkboxInput(ns("add_total_row"), "Add Total row", value = a$add_total_row),
430	!	checkboxInput(ns("add_total"), "Add All Patients column", value = a$add_total),
431	!	teal.widgets::panel_group(
432	!	teal.widgets::panel_item(
433	!	"Additional Variables Info",
434	!	teal.transform::data_extract_ui(
435	!	id = ns("id_var"),
436	!	label = "Subject Identifier",
437	!	data_extract_spec = a$id_var,
438	!	is_single_dataset = is_single_dataset_value
439		),
440	!	teal.transform::data_extract_ui(
441	!	id = ns("aval_var"),
442	!	label = "Analysis Value Variable",
443	!	data_extract_spec = a$aval_var,
444	!	is_single_dataset = is_single_dataset_value
445		),
446	!	teal.transform::data_extract_ui(
447	!	id = ns("avalu_var"),
448	!	label = "Analysis Value Unit Variable",
449	!	data_extract_spec = a$avalu_var,
450	!	is_single_dataset = is_single_dataset_value
451		)
452		)
453		)
454		),
455	!	forms = tagList(
456	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
457		),
458	!	pre_output = a$pre_output,
459	!	post_output = a$post_output
460		)
461		}
462
463		#' @keywords internal
464		srv_t_exposure <- function(id,
465		data,
466		reporter,
467		filter_panel_api,
468		dataname,
469		parentname,
470		paramcd,
471		paramcd_label,
472		id_var,
473		row_by_var,
474		col_by_var,
475		parcat,
476		aval_var,
477		avalu_var,
478		na_level,
479		label,
480		total_label,
481		total_row_label,
482		basic_table_args = basic_table_args) {
483	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
484	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
485	!	checkmate::assert_class(data, "reactive")
486	!	checkmate::assert_class(shiny::isolate(data()), "teal_data")
487	!	moduleServer(id, function(input, output, session) {
488	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
489	!	rule_intersection <- function(other) {
490	!	function(value) {
491	!	others <- selector_list()[[other]]()$select
492	!	if (length(intersect(value, others)) > 0L) {
493	!	"Column by and row by variables should not be the same."
494		}
495		}
496		}
497
498	!	selector_list <- teal.transform::data_extract_multiple_srv(
499	!	data_extract = list(
500	!	id_var = id_var,
501	!	paramcd = paramcd,
502	!	row_by_var = row_by_var,
503	!	col_by_var = col_by_var,
504	!	parcat = parcat,
505	!	aval_var = aval_var,
506	!	avalu_var = avalu_var
507		),
508	!	datasets = data,
509	!	select_validation_rule = list(
510	!	id_var = shinyvalidate::sv_required("Subject Identifier is required"),
511	!	col_by_var = shinyvalidate::compose_rules(
512	!	shinyvalidate::sv_optional(),
513	!	rule_intersection("row_by_var")
514		),
515	!	row_by_var = shinyvalidate::compose_rules(
516	!	shinyvalidate::sv_required("Please select a row by variable."),
517	!	rule_intersection("col_by_var")
518		),
519	!	aval_var = shinyvalidate::sv_required("Please select an analysis variable."),
520	!	avalu_var = shinyvalidate::sv_required("Please select an analysis unit variable.")
521		),
522	!	filter_validation_rule = list(
523	!	paramcd = shinyvalidate::sv_required("Please select a parameter value."),
524	!	parcat = shinyvalidate::sv_required("Please select a parameter category value.")
525		)
526		)
527
528	!	iv_r <- reactive({
529	!	iv <- shinyvalidate::InputValidator$new()
530	!	teal.transform::compose_and_enable_validators(iv, selector_list)
531		})
532
533	!	anl_inputs <- teal.transform::merge_expression_srv(
534	!	datasets = data,
535	!	selector_list = selector_list,
536	!	merge_function = "dplyr::inner_join"
537		)
538
539	!	adsl_inputs <- teal.transform::merge_expression_module(
540	!	datasets = data,
541	!	data_extract = list(col_by_var = col_by_var),
542	!	anl_name = "ANL_ADSL"
543		)
544
545	!	anl_q <- reactive({
546	!	data() %>%
547	!	teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
548	!	teal.code::eval_code(as.expression(adsl_inputs()$expr))
549		})
550
551	!	merged <- list(
552	!	anl_input_r = anl_inputs,
553	!	adsl_input_r = adsl_inputs,
554	!	anl_q = anl_q
555		)
556
557	!	validate_checks <- reactive({
558	!	adsl_filtered <- merged$anl_q()[[parentname]]
559	!	anl_filtered <- merged$anl_q()[[dataname]]
560
561	!	teal::validate_inputs(iv_r())
562
563	!	input_paramcd <- unlist(paramcd$filter)["vars_selected"]
564	!	input_id_var <- names(merged$anl_input_r()$columns_source$id_var)
565	!	input_row_by_var <- names(merged$anl_input_r()$columns_source$row_by_var)
566	!	input_col_by_var <- names(merged$adsl_input_r()$columns_source$col_by_var)
567	!	input_parcat <- unlist(parcat$filter)["vars_selected"]
568	!	input_aval_var <- names(merged$anl_input_r()$columns_source$aval_var)
569	!	input_avalu_var <- names(merged$anl_input_r()$columns_source$avalu_var)
570
571		# validate inputs
572	!	validate_standard_inputs(
573	!	adsl = adsl_filtered,
574	!	adslvars = c("USUBJID", "STUDYID", input_col_by_var),
575	!	anl = anl_filtered,
576	!	anlvars = c(
577	!	"USUBJID", "STUDYID", input_id_var, input_paramcd,
578	!	input_row_by_var, input_parcat, input_aval_var, input_avalu_var
579		),
580	!	arm_var = NULL,
581	!	need_arm = FALSE
582		)
583	!	NULL
584		})
585
586	!	all_q <- reactive({
587	!	validate_checks()
588
589	!	anl_filtered <- merged$anl_q()[[dataname]]
590	!	input_avalu_var <- as.character(
591	!	unique(merged$anl_q()[["ANL"]][[names(merged$anl_input_r()$columns_source$avalu_var)[1]]])
592		)
593	!	input_paramcd <- as.character(
594	!	unique(merged$anl_q()[["ANL"]][[names(merged$anl_input_r()$columns_source$paramcd)[1]]])
595		)
596
597	!	if (is.null(paramcd_label)) {
598	!	input_paramcd_label <- input_paramcd
599		} else {
600	!	paramcd <- names(merged$anl_input_r()$columns_source$paramcd)
601	!	paramcd_map_list <- c(paramcd, paramcd_label)
602	!	paramcd_map <- unique(anl_filtered[paramcd_map_list])
603	!	input_paramcd_label <- as.character(paramcd_map[paramcd_map[1] == input_paramcd, 2])
604		}
605
606	!	basic_table_args$title <- "Duration of Exposure Table"
607	!	basic_table_args$subtitles <-
608	!	paste("Parameter Category:", merged$anl_input_r()$filter_info$parcat[[1]]$selected[[1]])
609
610	!	my_calls <- template_exposure(
611	!	parentname = "ANL_ADSL",
612	!	dataname = "ANL",
613	!	id_var = names(merged$anl_input_r()$columns_source$id_var),
614	!	paramcd = input_paramcd,
615	!	paramcd_label = input_paramcd_label,
616	!	row_by_var = names(merged$anl_input_r()$columns_source$row_by_var),
617	!	col_by_var = names(merged$anl_input_r()$columns_source$col_by_var),
618	!	add_total = input$add_total,
619	!	total_label = total_label,
620	!	add_total_row = input$add_total_row,
621	!	total_row_label = total_row_label,
622	!	drop_levels = TRUE,
623	!	na_level = na_level,
624	!	aval_var = names(merged$anl_input_r()$columns_source$aval_var),
625	!	avalu_var = input_avalu_var,
626	!	basic_table_args = basic_table_args
627		)
628	!	teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
629		})
630
631		# Outputs to render.
632	!	table_r <- reactive(all_q()[["result"]])
633
634	!	teal.widgets::table_with_settings_srv(
635	!	id = "table",
636	!	table_r = table_r
637		)
638
639		# Render R code.
640	!	teal.widgets::verbatim_popup_srv(
641	!	id = "rcode",
642	!	verbatim_content = reactive(teal.code::get_code(all_q())),
643	!	title = label
644		)
645
646		### REPORTER
647	!	if (with_reporter) {
648	!	card_fun <- function(comment, label) {
649	!	card <- teal::report_card_template(
650	!	title = "Exposure for Risk Management Plan Table",
651	!	label = label,
652	!	with_filter = with_filter,
653	!	filter_panel_api = filter_panel_api
654		)
655	!	card$append_text("Table", "header3")
656	!	card$append_table(table_r())
657	!	if (!comment == "") {
658	!	card$append_text("Comment", "header3")
659	!	card$append_text(comment)
660		}
661	!	card$append_src(teal.code::get_code(all_q()))
662	!	card
663		}
664	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
665		}
666		###
667		})
668		}

1		#' Template: Patient Profile Laboratory Table
2		#'
3		#' Creates a valid expression to generate a patient profile laboratory table using ADaM datasets.
4		#'
5		#' @inheritParams template_arguments
6		#' @param paramcd (`character`)\cr name of the parameter code variable.
7		#' @param param (`character`)\cr name of the parameter variable.
8		#' @param timepoints (`character`)\cr name of time variable.
9		#' @param anrind (`character`)\cr name of the analysis reference range indicator variable.
10		#' @param round_value (`numeric`)\cr number of decimal places to round to.
11		#'
12		#' @inherit template_arguments return
13		#'
14		#' @seealso [tm_t_pp_laboratory()]
15		#'
16		#' @keywords internal
17		template_laboratory <- function(dataname = "ANL",
18		paramcd = "PARAMCD",
19		param = "PARAM",
20		anrind = "ANRIND",
21		timepoints = "ADY",
22		aval = lifecycle::deprecated(),
23		aval_var = "AVAL",
24		avalu = lifecycle::deprecated(),
25		avalu_var = "AVALU",
26		patient_id = NULL,
27		round_value = 0L) {
28	!	if (lifecycle::is_present(aval)) {
29	!	aval_var <- aval
30	!	warning(
31	!	"The `aval` argument of `template_laboratory()` is deprecated as of teal.modules.clinical 0.8.16. ",
32	!	"Please use the `aval_var` argument instead.",
33	!	call. = FALSE
34		)
35		}
36
37	!	if (lifecycle::is_present(avalu)) {
38	!	avalu_var <- avalu
39	!	warning(
40	!	"The `avalu` argument of `template_laboratory()` is deprecated as of teal.modules.clinical 0.8.16. ",
41	!	"Please use the `avalu_var` argument instead.",
42	!	call. = FALSE
43		)
44		}
45
46	!	checkmate::assert_string(dataname)
47	!	checkmate::assert_string(paramcd)
48	!	checkmate::assert_string(param)
49	!	checkmate::assert_string(anrind)
50	!	checkmate::assert_string(timepoints)
51	!	checkmate::assert_string(aval_var)
52	!	checkmate::assert_string(avalu_var)
53	!	checkmate::assert_integer(round_value, lower = 0)
54
55	!	y <- list()
56	!	y$table <- list()
57
58	!	table_lab_list <- add_expr(
59	!	list(),
60	!	substitute(
61	!	expr = {
62	!	dataname[, aval_char] <- round(dataname[, aval_char], round_value)
63	!	labor_table_base <- dataname %>%
64	!	dplyr::select(timepoints, paramcd, param, aval_var, avalu_var, anrind) %>%
65	!	dplyr::arrange(timepoints) %>%
66	!	dplyr::select(-timepoints) %>%
67	!	dplyr::group_by(paramcd, param) %>%
68	!	dplyr::mutate(INDEX = dplyr::row_number()) %>%
69	!	dplyr::ungroup() %>%
70	!	dplyr::mutate(aval_anrind = paste(aval_var, anrind)) %>%
71	!	dplyr::select(-c(aval_var, anrind))
72
73	!	labor_table_raw <- labor_table_base %>%
74	!	as.data.frame() %>%
75	!	stats::reshape(
76	!	direction = "wide",
77	!	idvar = c(paramcd_char, param_char, avalu_char),
78	!	v.names = "aval_anrind",
79	!	timevar = "INDEX"
80		)
81	!	colnames(labor_table_raw)[-c(1:3)] <- unique(labor_table_base$INDEX)
82
83	!	labor_table_raw[[param_char]] <- clean_description(labor_table_raw[[param_char]])
84
85	!	labor_table_raw <- rlistings::as_listing(
86	!	labor_table_raw,
87	!	key_cols = NULL,
88	!	default_formatting = list(all = fmt_config(align = "left"))
89		)
90	!	main_title(labor_table_raw) <- paste("Patient ID:", patient_id)
91
92	!	labor_table_html <- labor_table_base %>%
93	!	dplyr::mutate(aval_anrind_col = color_lab_values(aval_anrind)) %>%
94	!	dplyr::select(-aval_anrind) %>%
95	!	as.data.frame() %>%
96	!	stats::reshape(
97	!	direction = "wide",
98	!	idvar = c(paramcd_char, param_char, avalu_char),
99	!	v.names = "aval_anrind_col",
100	!	timevar = "INDEX"
101		)
102	!	colnames(labor_table_html)[-c(1:3)] <- unique(labor_table_base$INDEX)
103	!	labor_table_html[[param_char]] <- clean_description(labor_table_html[[param_char]])
104
105	!	labor_table_html_dt <- DT::datatable(labor_table_html, escape = FALSE)
106	!	labor_table_html_dt$dependencies <- c(
107	!	labor_table_html_dt$dependencies,
108	!	list(rmarkdown::html_dependency_bootstrap("default"))
109		)
110	!	labor_table_html_dt
111		},
112	!	env = list(
113	!	dataname = as.name(dataname),
114	!	param = as.name(param),
115	!	param_char = param,
116	!	paramcd = as.name(paramcd),
117	!	paramcd_char = paramcd,
118	!	aval_var = as.name(aval_var),
119	!	aval_char = aval_var,
120	!	avalu_var = as.name(avalu_var),
121	!	avalu_char = avalu_var,
122	!	timepoints = as.name(timepoints),
123	!	anrind = as.name(anrind),
124	!	patient_id = patient_id,
125	!	round_value = round_value
126		)
127		)
128		)
129
130	!	y$table <- bracket_expr(table_lab_list)
131	!	y
132		}
133
134		#' teal Module: Patient Profile Laboratory Table
135		#'
136		#' This module produces a patient profile laboratory table using ADaM datasets.
137		#'
138		#' @inheritParams module_arguments
139		#' @inheritParams template_laboratory
140		#' @param param ([teal.transform::choices_selected()])\cr object with all
141		#' available choices and preselected option for the `PARAM` variable from `dataname`.
142		#' @param timepoints ([teal.transform::choices_selected()])\cr object with all
143		#' available choices and preselected option for the time variable from `dataname`.
144		#' @param anrind ([teal.transform::choices_selected()])\cr object with all
145		#' available choices and preselected option for the `ANRIND` variable from `dataname`. Variable should have the
146		#' following 3 levels: `"HIGH"`, `"LOW"`, and `"NORMAL"`.
147		#'
148		#' @inherit module_arguments return
149		#'
150		#' @examples
151		#' ADSL <- tmc_ex_adsl
152		#' ADLB <- tmc_ex_adlb
153		#'
154		#' app <- init(
155		#' data = cdisc_data(
156		#' ADSL = ADSL,
157		#' ADLB = ADLB,
158		#' code = "
159		#' ADSL <- tmc_ex_adsl
160		#' ADLB <- tmc_ex_adlb
161		#' "
162		#' ),
163		#' modules = modules(
164		#' tm_t_pp_laboratory(
165		#' label = "Vitals",
166		#' dataname = "ADLB",
167		#' patient_col = "USUBJID",
168		#' paramcd = choices_selected(
169		#' choices = variable_choices(ADLB, "PARAMCD"),
170		#' selected = "PARAMCD"
171		#' ),
172		#' param = choices_selected(
173		#' choices = variable_choices(ADLB, "PARAM"),
174		#' selected = "PARAM"
175		#' ),
176		#' timepoints = choices_selected(
177		#' choices = variable_choices(ADLB, "ADY"),
178		#' selected = "ADY"
179		#' ),
180		#' anrind = choices_selected(
181		#' choices = variable_choices(ADLB, "ANRIND"),
182		#' selected = "ANRIND"
183		#' ),
184		#' aval_var = choices_selected(
185		#' choices = variable_choices(ADLB, "AVAL"),
186		#' selected = "AVAL"
187		#' ),
188		#' avalu_var = choices_selected(
189		#' choices = variable_choices(ADLB, "AVALU"),
190		#' selected = "AVALU"
191		#' )
192		#' )
193		#' )
194		#' )
195		#' if (interactive()) {
196		#' shinyApp(app$ui, app$server)
197		#' }
198		#'
199		#' @export
200		tm_t_pp_laboratory <- function(label,
201		dataname = "ADLB",
202		parentname = "ADSL",
203		patient_col = "USUBJID",
204		timepoints = NULL,
205		aval = lifecycle::deprecated(),
206		aval_var = NULL,
207		avalu = lifecycle::deprecated(),
208		avalu_var = NULL,
209		param = NULL,
210		paramcd = NULL,
211		anrind = NULL,
212		pre_output = NULL,
213		post_output = NULL) {
214	!	if (lifecycle::is_present(aval)) {
215	!	aval_var <- aval
216	!	warning(
217	!	"The `aval` argument of `tm_t_pp_laboratory()` is deprecated as of teal.modules.clinical 0.8.16. ",
218	!	"Please use the `aval_var` argument instead.",
219	!	call. = FALSE
220		)
221		} else {
222	!	aval <- aval_var # resolves missing argument error
223		}
224
225	!	if (lifecycle::is_present(avalu)) {
226	!	avalu_var <- avalu
227	!	warning(
228	!	"The `avalu` argument of `tm_t_pp_laboratory()` is deprecated as of teal.modules.clinical 0.8.16. ",
229	!	"Please use the `avalu_var` argument instead.",
230	!	call. = FALSE
231		)
232		} else {
233	!	avalu <- avalu_var # resolves missing argument error
234		}
235
236	!	message("Initializing tm_t_pp_laboratory")
237	!	checkmate::assert_string(label)
238	!	checkmate::assert_string(dataname)
239	!	checkmate::assert_string(parentname)
240	!	checkmate::assert_string(patient_col)
241	!	checkmate::assert_class(timepoints, "choices_selected", null.ok = TRUE)
242	!	checkmate::assert_class(aval_var, "choices_selected", null.ok = TRUE)
243	!	checkmate::assert_class(avalu_var, "choices_selected", null.ok = TRUE)
244	!	checkmate::assert_class(param, "choices_selected", null.ok = TRUE)
245	!	checkmate::assert_class(paramcd, "choices_selected", null.ok = TRUE)
246	!	checkmate::assert_class(anrind, "choices_selected", null.ok = TRUE)
247	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
248	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
249
250	!	args <- as.list(environment())
251	!	data_extract_list <- list(
252	!	timepoints = `if`(is.null(timepoints), NULL, cs_to_des_select(timepoints, dataname = dataname)),
253	!	aval_var = `if`(is.null(aval_var), NULL, cs_to_des_select(aval_var, dataname = dataname)),
254	!	avalu_var = `if`(is.null(avalu_var), NULL, cs_to_des_select(avalu_var, dataname = dataname)),
255	!	param = `if`(is.null(param), NULL, cs_to_des_select(param, dataname = dataname)),
256	!	paramcd = `if`(is.null(paramcd), NULL, cs_to_des_select(paramcd, dataname = dataname)),
257	!	anrind = `if`(is.null(anrind), NULL, cs_to_des_select(anrind, dataname = dataname))
258		)
259
260	!	module(
261	!	label = label,
262	!	ui = ui_g_laboratory,
263	!	ui_args = c(data_extract_list, args),
264	!	server = srv_g_laboratory,
265	!	server_args = c(
266	!	data_extract_list,
267	!	list(
268	!	dataname = dataname,
269	!	parentname = parentname,
270	!	label = label,
271	!	patient_col = patient_col
272		)
273		),
274	!	datanames = c(dataname, parentname)
275		)
276		}
277
278		#' @keywords internal
279		ui_g_laboratory <- function(id, ...) {
280	!	ui_args <- list(...)
281	!	is_single_dataset_value <- teal.transform::is_single_dataset(
282	!	ui_args$timepoints,
283	!	ui_args$aval_var,
284	!	ui_args$avalu_var,
285	!	ui_args$param,
286	!	ui_args$paramcd,
287	!	ui_args$anrind
288		)
289
290	!	ns <- NS(id)
291	!	teal.widgets::standard_layout(
292	!	output = tags$div(
293	!	htmlOutput(ns("title")),
294	!	DT::DTOutput(outputId = ns("lab_values_table"))
295		),
296	!	encoding = tags$div(
297		### Reporter
298	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
299		###
300	!	tags$label("Encodings", class = "text-primary"),
301	!	teal.transform::datanames_input(ui_args[c("timepoints", "aval_var", "avalu_var", "param", "paramcd", "anrind")]),
302	!	teal.widgets::optionalSelectInput(
303	!	ns("patient_id"),
304	!	"Select Patient:",
305	!	multiple = FALSE,
306	!	options = shinyWidgets::pickerOptions(`liveSearch` = TRUE)
307		),
308	!	teal.transform::data_extract_ui(
309	!	id = ns("paramcd"),
310	!	label = "Select PARAMCD variable:",
311	!	data_extract_spec = ui_args$paramcd,
312	!	is_single_dataset = is_single_dataset_value
313		),
314	!	teal.transform::data_extract_ui(
315	!	id = ns("param"),
316	!	label = "Select PARAM variable:",
317	!	data_extract_spec = ui_args$param,
318	!	is_single_dataset = is_single_dataset_value
319		),
320	!	teal.transform::data_extract_ui(
321	!	id = ns("timepoints"),
322	!	label = "Select timepoints variable:",
323	!	data_extract_spec = ui_args$timepoints,
324	!	is_single_dataset = is_single_dataset_value
325		),
326	!	teal.transform::data_extract_ui(
327	!	id = ns("aval_var"),
328	!	label = "Select AVAL variable:",
329	!	data_extract_spec = ui_args$aval_var,
330	!	is_single_dataset = is_single_dataset_value
331		),
332	!	teal.transform::data_extract_ui(
333	!	id = ns("avalu_var"),
334	!	label = "Select AVALU variable:",
335	!	data_extract_spec = ui_args$avalu_var,
336	!	is_single_dataset = is_single_dataset_value
337		),
338	!	teal.transform::data_extract_ui(
339	!	id = ns("anrind"),
340	!	label = "Select ANRIND variable:",
341	!	data_extract_spec = ui_args$anrind,
342	!	is_single_dataset = is_single_dataset_value
343		),
344	!	selectInput(
345	!	inputId = ns("round_value"),
346	!	label = "Select number of decimal places for rounding:",
347	!	choices = NULL
348		)
349		),
350	!	forms = tagList(
351	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
352		),
353	!	pre_output = ui_args$pre_output,
354	!	post_output = ui_args$post_output
355		)
356		}
357
358		#' @keywords internal
359		srv_g_laboratory <- function(id,
360		data,
361		reporter,
362		filter_panel_api,
363		dataname,
364		parentname,
365		patient_col,
366		timepoints,
367		aval_var,
368		avalu_var,
369		param,
370		paramcd,
371		anrind,
372		label) {
373	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
374	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
375	!	checkmate::assert_class(data, "reactive")
376	!	checkmate::assert_class(shiny::isolate(data()), "teal_data")
377
378	!	moduleServer(id, function(input, output, session) {
379	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
380	!	patient_id <- reactive(input$patient_id)
381
382		# Init
383	!	patient_data_base <- reactive(unique(data()[[parentname]][[patient_col]]))
384	!	teal.widgets::updateOptionalSelectInput(
385	!	session,
386	!	"patient_id",
387	!	choices = patient_data_base(),
388	!	selected = patient_data_base()[1]
389		)
390
391	!	observeEvent(patient_data_base(),
392	!	handlerExpr = {
393	!	teal.widgets::updateOptionalSelectInput(
394	!	session,
395	!	"patient_id",
396	!	choices = patient_data_base(),
397	!	selected = if (length(patient_data_base()) == 1) {
398	!	patient_data_base()
399		} else {
400	!	intersect(patient_id(), patient_data_base())
401		}
402		)
403		},
404	!	ignoreInit = TRUE
405		)
406
407		# Update round_values
408	!	aval_values <- isolate(data())[[dataname]][, aval_var$select$selected]
409	!	decimal_nums <- aval_values[trunc(aval_values) != aval_values]
410	!	max_decimal <- max(nchar(gsub("([0-9]+).([0-9]+)", "\\2", decimal_nums)))
411
412	!	updateSelectInput(
413	!	session,
414	!	"round_value",
415	!	choices = seq(0, max_decimal),
416	!	selected = min(4, max_decimal)
417		)
418
419		# Laboratory values tab ----
420	!	selector_list <- teal.transform::data_extract_multiple_srv(
421	!	data_extract = list(
422	!	timepoints = timepoints,
423	!	aval_var = aval_var,
424	!	avalu_var = avalu_var,
425	!	param = param,
426	!	paramcd = paramcd,
427	!	anrind = anrind
428		),
429	!	datasets = data,
430	!	select_validation_rule = list(
431	!	timepoints = shinyvalidate::sv_required("Please select timepoints variable."),
432	!	aval_var = shinyvalidate::sv_required("Please select AVAL variable."),
433	!	avalu_var = shinyvalidate::sv_required("Please select AVALU variable."),
434	!	param = shinyvalidate::sv_required("Please select PARAM variable."),
435	!	paramcd = shinyvalidate::sv_required("Please select PARAMCD variable."),
436	!	anrind = shinyvalidate::sv_required("Please select ANRIND variable.")
437		)
438		)
439
440	!	iv_r <- reactive({
441	!	iv <- shinyvalidate::InputValidator$new()
442	!	iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient"))
443	!	teal.transform::compose_and_enable_validators(iv, selector_list)
444		})
445
446	!	anl_inputs <- teal.transform::merge_expression_srv(
447	!	datasets = data,
448	!	selector_list = selector_list
449		)
450
451	!	anl_q <- reactive({
452	!	data() %>%
453	!	teal.code::eval_code(as.expression(anl_inputs()$expr))
454		})
455
456	!	all_q <- reactive({
457	!	teal::validate_inputs(iv_r())
458
459	!	labor_calls <- template_laboratory(
460	!	dataname = "ANL",
461	!	timepoints = input[[extract_input("timepoints", dataname)]],
462	!	aval_var = input[[extract_input("aval_var", dataname)]],
463	!	avalu_var = input[[extract_input("avalu_var", dataname)]],
464	!	param = input[[extract_input("param", dataname)]],
465	!	paramcd = input[[extract_input("paramcd", dataname)]],
466	!	anrind = input[[extract_input("anrind", dataname)]],
467	!	patient_id = patient_id(),
468	!	round_value = as.integer(input$round_value)
469		)
470
471	!	teal.code::eval_code(
472	!	anl_q(),
473	!	substitute(
474	!	expr = {
475	!	pt_id <- patient_id
476	!	ANL <- ANL[ANL[[patient_col]] == patient_id, ]
477	!	}, env = list(
478	!	patient_col = patient_col,
479	!	patient_id = patient_id()
480		)
481		)
482		) %>%
483	!	teal.code::eval_code(as.expression(labor_calls))
484		})
485
486	!	output$title <- renderText({
487	!	paste("<h5><b>Patient ID:", all_q()[["pt_id"]], "</b></h5>")
488		})
489
490	!	table_r <- reactive({
491	!	q <- all_q()
492	!	list(
493	!	html = q[["labor_table_html"]],
494	!	raw = q[["labor_table_raw"]]
495		)
496		})
497
498	!	output$lab_values_table <- DT::renderDataTable(
499	!	expr = table_r()$html,
500	!	escape = FALSE,
501	!	options = list(
502	!	lengthMenu = list(list(-1, 5, 10, 25), list("All", "5", "10", "25")),
503	!	scrollX = TRUE
504		)
505		)
506
507	!	teal.widgets::verbatim_popup_srv(
508	!	id = "rcode",
509	!	verbatim_content = reactive(teal.code::get_code(all_q())),
510	!	title = label
511		)
512
513		### REPORTER
514	!	if (with_reporter) {
515	!	card_fun <- function(comment, label) {
516	!	card <- teal::report_card_template(
517	!	title = "Patient Profile Laboratory Table",
518	!	label = label,
519	!	with_filter = with_filter,
520	!	filter_panel_api = filter_panel_api
521		)
522	!	card$append_text("Table", "header3")
523	!	card$append_table(table_r()$raw)
524	!	if (!comment == "") {
525	!	card$append_text("Comment", "header3")
526	!	card$append_text(comment)
527		}
528	!	card$append_src(teal.code::get_code(all_q()))
529	!	card
530		}
531	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
532		}
533		###
534		})
535		}

1		#' Template: Summary of Variables
2		#'
3		#' Creates a valid expression to generate a table to summarize variables.
4		#'
5		#' @inheritParams template_arguments
6		#' @param show_labels `r lifecycle::badge("deprecated")`
7		#' @param arm_var_labels (`character` or `NULL`)\cr vector of column variable labels to display, of the same length as
8		#' `arm_var`. If `NULL`, no labels will be displayed.
9		#'
10		#' @inherit template_arguments return
11		#'
12		#' @seealso [tm_t_summary()]
13		#'
14		#' @keywords internal
15		template_summary <- function(dataname,
16		parentname,
17		arm_var,
18		sum_vars,
19		show_labels = lifecycle::deprecated(),
20		add_total = TRUE,
21		total_label = default_total_label(),
22		var_labels = character(),
23		arm_var_labels = NULL,
24		na.rm = FALSE, # nolint: object_name.
25		na_level = default_na_str(),
26		numeric_stats = c(
27		"n", "mean_sd", "mean_ci", "median", "median_ci", "quantiles", "range", "geom_mean"
28		),
29		denominator = c("N", "n", "omit"),
30		drop_arm_levels = TRUE,
31		basic_table_args = teal.widgets::basic_table_args()) {
32	6x	if (lifecycle::is_present(show_labels)) {
33	!	warning(
34	!	"The `show_labels` argument of `template_summary` is deprecated as of teal.modules.clinical 0.9.1.9013 ",
35	!	"as it is has no effect on the module.",
36	!	call. = FALSE
37		)
38		}
39
40	6x	checkmate::assert_string(dataname)
41	6x	checkmate::assert_string(parentname)
42	6x	checkmate::assert_character(arm_var, min.len = 1, max.len = 2)
43	6x	checkmate::assert_character(sum_vars)
44	6x	checkmate::assert_flag(add_total)
45	6x	checkmate::assert_string(total_label)
46	6x	checkmate::assert_character(var_labels)
47	6x	checkmate::assert_character(arm_var_labels, len = length(arm_var), null.ok = TRUE)
48	6x	checkmate::assert_flag(na.rm)
49	6x	checkmate::assert_string(na_level)
50	6x	checkmate::assert_flag(drop_arm_levels)
51	6x	checkmate::assert_character(numeric_stats, min.len = 1)
52	6x	checkmate::assert_subset(
53	6x	numeric_stats,
54	6x	c("n", "mean_sd", "mean_ci", "median", "median_ci", "quantiles", "range", "geom_mean")
55		)
56
57	6x	denominator <- match.arg(denominator)
58
59	6x	y <- list()
60
61		# Data processing
62	6x	data_list <- list()
63
64	6x	data_list <- add_expr(
65	6x	data_list,
66	6x	substitute(
67	6x	expr = anl <- df %>%
68	6x	df_explicit_na(omit_columns = setdiff(names(df), c(sum_vars)), na_level = na_str),
69	6x	env = list(
70	6x	df = as.name(dataname),
71	6x	sum_vars = sum_vars,
72	6x	na_str = na_level
73		)
74		)
75		)
76
77	6x	prepare_arm_levels_call <- lapply(arm_var, function(x) {
78	10x	prepare_arm_levels(
79	10x	dataname = "anl",
80	10x	parentname = parentname,
81	10x	arm_var = x,
82	10x	drop_arm_levels = drop_arm_levels
83		)
84		})
85	6x	data_list <- Reduce(add_expr, prepare_arm_levels_call, init = data_list)
86
87	6x	data_list <- add_expr(
88	6x	data_list,
89	6x	substitute(
90	6x	expr = parentname <- df_explicit_na(parentname, na_level = na_str),
91	6x	env = list(
92	6x	parentname = as.name(parentname),
93	6x	na_str = na_level
94		)
95		)
96		)
97
98	6x	y$data <- bracket_expr(data_list)
99
100	6x	parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
101	6x	teal.widgets::resolve_basic_table_args(
102	6x	user_table = basic_table_args,
103	6x	module_table = teal.widgets::basic_table_args(
104	6x	show_colcounts = TRUE,
105	6x	main_footer =
106	6x	"n represents the number of unique subject IDs such that the variable has non-NA values."
107		)
108		)
109		)
110
111	6x	layout_list <- list()
112	6x	layout_list <- add_expr(
113	6x	layout_list,
114	6x	parsed_basic_table_args
115		)
116
117		# Build layout
118	6x	split_cols_call <- lapply(arm_var, function(x) {
119	10x	if (drop_arm_levels) {
120	9x	substitute(
121	9x	expr = rtables::split_cols_by(x, split_fun = drop_split_levels),
122	9x	env = list(x = x)
123		)
124		} else {
125	1x	substitute(
126	1x	expr = rtables::split_cols_by(x),
127	1x	env = list(x = x)
128		)
129		}
130		})
131	6x	layout_list <- Reduce(add_expr, split_cols_call, init = layout_list)
132
133	6x	if (add_total) {
134	3x	layout_list <- add_expr(
135	3x	layout_list,
136	3x	substitute(
137	3x	expr = rtables::add_overall_col(total_label),
138	3x	env = list(total_label = total_label)
139		)
140		)
141		}
142
143	6x	env_sum_vars <- list(
144	6x	sum_vars = sum_vars,
145	6x	sum_var_labels = var_labels[sum_vars],
146	6x	na.rm = na.rm,
147	6x	na_level = na_level,
148	6x	denom = ifelse(denominator == "n", "n", "N_col"),
149	6x	stats = c(
150	6x	numeric_stats,
151	6x	ifelse(denominator == "omit", "count", "count_fraction")
152		)
153		)
154
155	6x	layout_list <- add_expr(
156	6x	layout_list,
157	6x	if (length(var_labels) > 0) {
158	1x	substitute(
159	1x	expr = analyze_vars(
160	1x	vars = sum_vars,
161	1x	var_labels = sum_var_labels,
162	1x	show_labels = "visible",
163	1x	na.rm = na.rm,
164	1x	na_str = na_level,
165	1x	denom = denom,
166	1x	.stats = stats
167		),
168	1x	env = env_sum_vars
169		)
170		} else {
171	5x	substitute(
172	5x	expr = analyze_vars(
173	5x	vars = sum_vars,
174	5x	show_labels = "visible",
175	5x	na.rm = na.rm,
176	5x	na_str = na_level,
177	5x	denom = denom,
178	5x	.stats = stats
179		),
180	5x	env = env_sum_vars
181		)
182		}
183		)
184
185	6x	if (!is.null(arm_var_labels)) {
186	1x	layout_list <- add_expr(
187	1x	layout_list,
188	1x	substitute(
189	1x	expr = append_topleft(arm_var_labels),
190	1x	env = list(arm_var_labels = c(arm_var_labels, ""))
191		)
192		)
193		}
194
195	6x	y$layout <- substitute(
196	6x	expr = lyt <- layout_pipe,
197	6x	env = list(layout_pipe = pipe_expr(layout_list))
198		)
199
200	6x	y$table <- substitute(
201	6x	expr = {
202	!	result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
203	!	result
204		},
205	6x	env = list(parent = as.name(parentname))
206		)
207
208	6x	y
209		}
210
211		#' teal Module: Summary of Variables
212		#'
213		#' This module produces a table to summarize variables.
214		#'
215		#' @inheritParams module_arguments
216		#' @inheritParams template_summary
217		#' @param arm_var ([teal.transform::choices_selected()])\cr object with all
218		#' available choices and preselected option for variable names that can be used as `arm_var`.
219		#' It defines the grouping variable(s) in the results table.
220		#' If there are two elements selected for `arm_var`,
221		#' second variable will be nested under the first variable.
222		#' @param show_arm_var_labels (`flag`)\cr whether arm variable label(s) should be displayed. Defaults to `TRUE`.
223		#'
224		#' @inherit module_arguments return seealso
225		#'
226		#' @examples
227		#' # Preparation of the test case - use `EOSDY` and `DCSREAS` variables to demonstrate missing data.
228		#' ADSL <- tmc_ex_adsl
229		#' ADSL$EOSDY[1] <- NA_integer_
230		#'
231		#' app <- init(
232		#' data = cdisc_data(
233		#' ADSL = ADSL,
234		#' code = "
235		#' ADSL <- tmc_ex_adsl
236		#' ADSL$EOSDY[1] <- NA_integer_
237		#' "
238		#' ),
239		#' modules = modules(
240		#' tm_t_summary(
241		#' label = "Demographic Table",
242		#' dataname = "ADSL",
243		#' arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"),
244		#' add_total = TRUE,
245		#' summarize_vars = choices_selected(
246		#' c("SEX", "RACE", "BMRKR2", "EOSDY", "DCSREAS", "AGE"),
247		#' c("SEX", "RACE")
248		#' ),
249		#' useNA = "ifany"
250		#' )
251		#' )
252		#' )
253		#' if (interactive()) {
254		#' shinyApp(app$ui, app$server)
255		#' }
256		#'
257		#' @export
258		tm_t_summary <- function(label,
259		dataname,
260		parentname = ifelse(
261		inherits(arm_var, "data_extract_spec"),
262		teal.transform::datanames_input(arm_var),
263		"ADSL"
264		),
265		arm_var,
266		summarize_vars,
267		add_total = TRUE,
268		total_label = default_total_label(),
269		show_arm_var_labels = TRUE,
270		useNA = c("ifany", "no"), # nolint: object_name.
271		na_level = default_na_str(),
272		numeric_stats = c(
273		"n", "mean_sd", "mean_ci", "median", "median_ci", "quantiles", "range", "geom_mean"
274		),
275		denominator = c("N", "n", "omit"),
276		drop_arm_levels = TRUE,
277		pre_output = NULL,
278		post_output = NULL,
279		basic_table_args = teal.widgets::basic_table_args()) {
280	!	message("Initializing tm_t_summary")
281	!	checkmate::assert_string(label)
282	!	checkmate::assert_string(dataname)
283	!	checkmate::assert_string(parentname)
284	!	checkmate::assert_class(arm_var, "choices_selected")
285	!	checkmate::assert_class(summarize_vars, "choices_selected")
286	!	checkmate::assert_string(na_level)
287	!	checkmate::assert_character(numeric_stats, min.len = 1)
288	!	checkmate::assert_flag(drop_arm_levels)
289	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
290	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
291	!	checkmate::assert_class(basic_table_args, "basic_table_args")
292	!	checkmate::assert_flag(add_total)
293	!	checkmate::assert_flag(show_arm_var_labels)
294	!	checkmate::assert_string(total_label)
295
296	!	useNA <- match.arg(useNA) # nolint: object_name.
297	!	denominator <- match.arg(denominator)
298	!	numeric_stats <- match.arg(numeric_stats, several.ok = TRUE)
299
300	!	args <- as.list(environment())
301
302	!	data_extract_list <- list(
303	!	arm_var = cs_to_des_select(arm_var, dataname = parentname, multiple = TRUE, ordered = TRUE),
304	!	summarize_vars = cs_to_des_select(summarize_vars, dataname = dataname, multiple = TRUE, ordered = TRUE)
305		)
306
307	!	module(
308	!	label = label,
309	!	server = srv_summary,
310	!	ui = ui_summary,
311	!	ui_args = c(data_extract_list, args),
312	!	server_args = c(
313	!	data_extract_list,
314	!	list(
315	!	dataname = dataname,
316	!	parentname = parentname,
317	!	label = label,
318	!	show_arm_var_labels = show_arm_var_labels,
319	!	total_label = total_label,
320	!	na_level = na_level,
321	!	basic_table_args = basic_table_args
322		)
323		),
324	!	datanames = c(dataname, parentname)
325		)
326		}
327
328		#' @keywords internal
329		ui_summary <- function(id, ...) {
330	!	ns <- NS(id)
331	!	a <- list(...)
332
333	!	is_single_dataset_value <- teal.transform::is_single_dataset(a$arm_var, a$summarize_vars)
334
335	!	teal.widgets::standard_layout(
336	!	output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
337	!	encoding = tags$div(
338		### Reporter
339	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
340		###
341	!	tags$label("Encodings", class = "text-primary"),
342	!	teal.transform::datanames_input(a[c("arm_var", "summarize_vars")]),
343	!	teal.transform::data_extract_ui(
344	!	id = ns("arm_var"),
345	!	label = "Select Column Variable(s)",
346	!	data_extract_spec = a$arm_var,
347	!	is_single_dataset = is_single_dataset_value
348		),
349	!	checkboxInput(ns("add_total"), "Add All Patients column", value = a$add_total),
350	!	teal.transform::data_extract_ui(
351	!	id = ns("summarize_vars"),
352	!	label = "Summarize Variables",
353	!	data_extract_spec = a$summarize_vars,
354	!	is_single_dataset = is_single_dataset_value
355		),
356	!	teal.widgets::panel_group(
357	!	teal.widgets::panel_item(
358	!	"Additional table settings",
359	!	radioButtons(
360	!	ns("useNA"),
361	!	label = "Display NA counts",
362	!	choices = c("ifany", "no"),
363	!	selected = a$useNA
364		),
365	!	checkboxGroupInput(
366	!	ns("numeric_stats"),
367	!	label = "Choose the statistics to display for numeric variables",
368	!	choices = c(
369	!	"n" = "n",
370	!	"Mean (SD)" = "mean_sd",
371	!	"Mean 95% CI" = "mean_ci",
372	!	"Geometric Mean" = "geom_mean",
373	!	"Median" = "median",
374	!	"Median 95% CI" = "median_ci",
375	!	"25% and 75%-ile" = "quantiles",
376	!	"Min - Max" = "range"
377		),
378	!	selected = a$numeric_stats
379		),
380	!	radioButtons(
381	!	ns("denominator"),
382	!	label = "Denominator choice",
383	!	choices = c("N", "n", "omit"),
384	!	selected = a$denominator
385		),
386	!	if (a$dataname == a$parentname) {
387	!	shinyjs::hidden(
388	!	checkboxInput(
389	!	ns("drop_arm_levels"),
390	!	label = "it's a BUG if you see this",
391	!	value = TRUE
392		)
393		)
394		} else {
395	!	checkboxInput(
396	!	ns("drop_arm_levels"),
397	!	label = sprintf("Drop columns not in filtered %s", a$dataname),
398	!	value = a$drop_arm_levels
399		)
400		}
401		)
402		)
403		),
404	!	forms = tagList(
405	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
406		),
407	!	pre_output = a$pre_output,
408	!	post_output = a$post_output
409		)
410		}
411
412		#' @keywords internal
413		srv_summary <- function(id,
414		data,
415		reporter,
416		filter_panel_api,
417		dataname,
418		parentname,
419		arm_var,
420		summarize_vars,
421		add_total,
422		show_arm_var_labels,
423		total_label,
424		na_level,
425		drop_arm_levels,
426		label,
427		basic_table_args) {
428	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
429	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
430	!	checkmate::assert_class(data, "reactive")
431	!	checkmate::assert_class(shiny::isolate(data()), "teal_data")
432	!	moduleServer(id, function(input, output, session) {
433	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
434	!	selector_list <- teal.transform::data_extract_multiple_srv(
435	!	data_extract = list(arm_var = arm_var, summarize_vars = summarize_vars),
436	!	datasets = data,
437	!	select_validation_rule = list(
438	!	summarize_vars = shinyvalidate::sv_required("Please select a summarize variable"),
439	!	arm_var = ~ if (length(.) != 1 && length(.) != 2) {
440	!	"Please select 1 or 2 column variables"
441		}
442		)
443		)
444
445	!	iv_r <- reactive({
446	!	iv <- shinyvalidate::InputValidator$new()
447	!	iv$add_rule("numeric_stats", shinyvalidate::sv_required("Please select at least one statistic to display."))
448	!	teal.transform::compose_and_enable_validators(iv, selector_list)
449		})
450
451	!	anl_inputs <- teal.transform::merge_expression_srv(
452	!	id = "anl_merge",
453	!	datasets = data,
454	!	selector_list = selector_list,
455	!	merge_function = "dplyr::inner_join"
456		)
457
458	!	adsl_inputs <- teal.transform::merge_expression_module(
459	!	id = "adsl_merge",
460	!	datasets = data,
461	!	data_extract = list(arm_var = arm_var),
462	!	anl_name = "ANL_ADSL"
463		)
464
465	!	anl_q <- reactive({
466	!	data() %>%
467	!	teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
468	!	teal.code::eval_code(as.expression(adsl_inputs()$expr))
469		})
470
471	!	merged <- list(
472	!	anl_input_r = anl_inputs,
473	!	adsl_input_r = adsl_inputs,
474	!	anl_q = anl_q
475		)
476
477	!	observeEvent(merged$anl_input_r()$columns_source$summarize_vars, {
478	!	choices_classes <- sapply(
479	!	names(merged$anl_input_r()$columns_source$summarize_vars),
480	!	function(x) {
481	!	summarize_var_data <- data()[[summarize_vars$dataname]][[x]]
482	!	inherits(summarize_var_data, "numeric") \|
483	!	inherits(summarize_var_data, "integer")
484		}
485		)
486
487	!	if (any(choices_classes)) {
488	!	shinyjs::show("numeric_stats")
489		} else {
490	!	shinyjs::hide("numeric_stats")
491		}
492		})
493
494		# validate inputs
495	!	validate_checks <- reactive({
496	!	teal::validate_inputs(iv_r())
497	!	adsl_filtered <- merged$anl_q()[[parentname]]
498	!	anl_filtered <- merged$anl_q()[[dataname]]
499	!	anl <- merged$anl_q()[["ANL"]]
500
501		# we take names of the columns source as they match names of the input data in merge_datasets
502		# if we use $arm_var they might be renamed to <selector id>.arm_var
503	!	input_arm_var <- names(merged$anl_input_r()$columns_source$arm_var)
504	!	input_summarize_vars <- names(merged$anl_input_r()$columns_source$summarize_vars)
505
506	!	validate(
507	!	need(
508	!	length(unique(anl$USUBJID)) == nrow(anl),
509	!	paste0(
510	!	"Please choose an analysis dataset where each row represents a different subject, ",
511	!	"i.e. USUBJID is different in each row"
512		)
513		),
514	!	need(
515	!	!any(vapply(anl_filtered[, input_summarize_vars], inherits, c("Date", "POSIXt"),
516	!	FUN.VALUE = logical(1)
517		)),
518	!	"Date and POSIXt variables are not supported, please select other variables"
519		),
520	!	if (length(input_arm_var) == 2) {
521	!	need(
522	!	is.factor(adsl_filtered[[input_arm_var[[2]]]]) & all(!adsl_filtered[[input_arm_var[[2]]]] %in% c("", NA)),
523	!	"Please check nested treatment variable which needs to be a factor without NA or empty strings."
524		)
525		}
526		)
527
528	!	validate_standard_inputs(
529	!	adsl = adsl_filtered,
530	!	adslvars = c("USUBJID", "STUDYID", input_arm_var),
531	!	anl = anl_filtered,
532	!	anlvars = c("USUBJID", "STUDYID", input_summarize_vars),
533	!	arm_var = input_arm_var[[1]]
534		)
535		})
536
537		# generate r code for the analysis
538	!	all_q <- reactive({
539	!	validate_checks()
540
541	!	summarize_vars <- merged$anl_input_r()$columns_source$summarize_vars
542	!	var_labels <- teal.data::col_labels(data()[[dataname]][, summarize_vars, drop = FALSE])
543
544	!	arm_var_labels <- NULL
545	!	if (show_arm_var_labels) {
546	!	arm_vars <- merged$anl_input_r()$columns_source$arm_var
547	!	arm_var_labels <- teal.data::col_labels(data()[[dataname]][, arm_vars, drop = FALSE], fill = TRUE)
548		}
549
550	!	my_calls <- template_summary(
551	!	dataname = "ANL",
552	!	parentname = "ANL_ADSL",
553	!	arm_var = merged$anl_input_r()$columns_source$arm_var,
554	!	sum_vars = summarize_vars,
555	!	add_total = input$add_total,
556	!	total_label = total_label,
557	!	var_labels = var_labels,
558	!	arm_var_labels = arm_var_labels,
559	!	na.rm = ifelse(input$useNA == "ifany", FALSE, TRUE),
560	!	na_level = na_level,
561	!	numeric_stats = input$numeric_stats,
562	!	denominator = input$denominator,
563	!	drop_arm_levels = input$drop_arm_levels,
564	!	basic_table_args = basic_table_args
565		)
566
567	!	teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
568		})
569
570		# Outputs to render.
571	!	table_r <- reactive(all_q()[["result"]])
572	!	teal.widgets::table_with_settings_srv(id = "table", table_r = table_r)
573
574		# Render R code.
575	!	teal.widgets::verbatim_popup_srv(
576	!	id = "rcode",
577	!	verbatim_content = reactive(teal.code::get_code(all_q())),
578	!	title = label
579		)
580
581		### REPORTER
582	!	if (with_reporter) {
583	!	card_fun <- function(comment, label) {
584	!	card <- teal::report_card_template(
585	!	title = "Summary Table",
586	!	label = label,
587	!	with_filter = with_filter,
588	!	filter_panel_api = filter_panel_api
589		)
590	!	card$append_text("Table", "header3")
591	!	card$append_table(table_r())
592	!	if (!comment == "") {
593	!	card$append_text("Comment", "header3")
594	!	card$append_text(comment)
595		}
596	!	card$append_src(teal.code::get_code(all_q()))
597	!	card
598		}
599	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
600		}
601		###
602		})
603		}

1		#' Template for Generalized Estimating Equations (GEE) analysis module
2		#'
3		#' Creates a valid expression to generate an analysis table using Generalized Estimating Equations (GEE).
4		#'
5		#' @inheritParams template_arguments
6		#' @param output_table (`character`)\cr type of output table (`"t_gee_cov", "t_gee_coef", "t_gee_lsmeans"`).
7		#' @param data_model_fit (`character`)\cr dataset used to fit the model by `tern.gee::fit_gee()`.
8		#' @param dataname_lsmeans (`character`)\cr dataset used for `alt_counts_df` argument of `rtables::build_table()`.
9		#' @param split_covariates (`character`)\cr vector of names of variables to use as covariates in
10		#' `tern.gee::vars_gee()`.
11		#' @param cor_struct (`character`)\cr assumed correlation structure in `tern.gee::fit_gee`.
12		#'
13		#' @inherit template_arguments return
14		#'
15		#' @seealso [tm_a_gee()]
16		#'
17		#' @keywords internal
18		template_a_gee <- function(output_table,
19		data_model_fit = "ANL",
20		dataname_lsmeans = "ANL_ADSL",
21		input_arm_var = "ARM",
22		ref_group = "A: Drug X",
23		aval_var,
24		id_var,
25		arm_var,
26		visit_var,
27		split_covariates,
28		cor_struct,
29		conf_level = 0.95,
30		basic_table_args = teal.widgets::basic_table_args()) {
31	4x	y <- list()
32	4x	y$model <- list()
33	4x	y$table <- list()
34
35	4x	all_basic_table_args <- teal.widgets::resolve_basic_table_args(basic_table_args)
36
37	4x	model_list <- add_expr(
38	4x	list(),
39	4x	substitute(
40	4x	expr = {
41	!	model_fit <- tern.gee::fit_gee(
42	!	vars = tern.gee::vars_gee(
43	!	response = as.vector(aval_var),
44	!	covariates = as.vector(split_covariates),
45	!	id = as.vector(id_var),
46	!	arm = as.vector(arm_var),
47	!	visit = as.vector(visit_var)
48		),
49	!	data = data_model_fit,
50	!	regression = "logistic",
51	!	cor_struct = cor_struct
52		)
53		},
54	4x	env = list(
55	4x	data_model_fit = as.name(data_model_fit),
56	4x	aval_var = aval_var,
57	4x	split_covariates = split_covariates,
58	4x	id_var = id_var,
59	4x	arm_var = arm_var,
60	4x	visit_var = visit_var,
61	4x	cor_struct = cor_struct
62		)
63		)
64		)
65
66	4x	table_list <-
67	4x	add_expr(
68	4x	list(),
69	4x	if (output_table == "t_gee_cov") {
70	1x	substitute(
71	1x	expr = {
72	!	result_table <- tern.gee::as.rtable(model_fit, type = "cov")
73	!	subtitles(result_table) <- st
74	!	main_footer(result_table) <- mf
75		},
76	1x	env = list(
77	1x	st = basic_table_args$subtitles,
78	1x	mf = basic_table_args$main_footer
79		)
80		)
81	4x	} else if (output_table == "t_gee_coef") {
82	1x	substitute(
83	1x	expr = {
84	!	result_table <- tern.gee::as.rtable(data.frame(Coefficient = model_fit$coefficients))
85	!	subtitles(result_table) <- st
86	!	main_footer(result_table) <- mf
87		},
88	1x	env = list(
89	1x	conf_level = conf_level,
90	1x	st = basic_table_args$subtitles,
91	1x	mf = basic_table_args$main_footer
92		)
93		)
94	4x	} else if (output_table == "t_gee_lsmeans") {
95	2x	substitute(
96	2x	expr = {
97	!	lsmeans_fit_model <- tern.gee::lsmeans(model_fit, conf_level)
98	!	result_table <- rtables::basic_table(show_colcounts = TRUE) %>%
99	!	rtables::split_cols_by(var = input_arm_var, ref_group = model_fit$ref_level) %>%
100	!	tern.gee::summarize_gee_logistic() %>%
101	!	rtables::build_table(
102	!	df = lsmeans_fit_model,
103	!	alt_counts_df = dataname_lsmeans
104		)
105
106	!	subtitles(result_table) <- st
107	!	main_footer(result_table) <- mf
108	!	result_table
109		},
110	2x	env = list(
111	2x	dataname_lsmeans = as.name(dataname_lsmeans),
112	2x	conf_level = conf_level,
113	2x	input_arm_var = input_arm_var,
114	2x	st = basic_table_args$subtitles,
115	2x	mf = basic_table_args$main_footer
116		)
117		)
118		}
119		)
120		# Note: l_html_concomitant_adcm is still not included since one column is available out of 9
121
122	4x	y$model <- bracket_expr(model_list)
123	4x	y$table <- bracket_expr(table_list)
124
125	4x	y
126		}
127
128		#' teal Module: Generalized Estimating Equations (GEE) analysis
129		#'
130		#' This module produces an analysis table using Generalized Estimating Equations (GEE).
131		#'
132		#' @inheritParams module_arguments
133		#' @inheritParams template_arguments
134		#' @inheritParams template_a_gee
135		#'
136		#' @inherit module_arguments return seealso
137		#'
138		#' @examples
139		#' library(dplyr)
140		#' data <- teal_data()
141		#' data <- within(data, {
142		#' ADSL <- tmc_ex_adsl
143		#' ADQS <- tmc_ex_adqs %>%
144		#' filter(ABLFL != "Y" & ABLFL2 != "Y") %>%
145		#' mutate(
146		#' AVISIT = as.factor(AVISIT),
147		#' AVISITN = rank(AVISITN) %>%
148		#' as.factor() %>%
149		#' as.numeric() %>%
150		#' as.factor(),
151		#' AVALBIN = AVAL < 50 # Just as an example to get a binary endpoint.
152		#' ) %>%
153		#' droplevels()
154		#' })
155		#' datanames <- c("ADSL", "ADQS")
156		#' datanames(data) <- datanames
157		#' join_keys(data) <- default_cdisc_join_keys[datanames]
158		#'
159		#' app <- init(
160		#' data = data,
161		#' modules = modules(
162		#' tm_a_gee(
163		#' label = "GEE",
164		#' dataname = "ADQS",
165		#' aval_var = choices_selected("AVALBIN", fixed = TRUE),
166		#' id_var = choices_selected(c("USUBJID", "SUBJID"), "USUBJID"),
167		#' arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"),
168		#' visit_var = choices_selected(c("AVISIT", "AVISITN"), "AVISIT"),
169		#' paramcd = choices_selected(
170		#' choices = value_choices(data[["ADQS"]], "PARAMCD", "PARAM"),
171		#' selected = "FKSI-FWB"
172		#' ),
173		#' cov_var = choices_selected(c("BASE", "AGE", "SEX", "BASE:AVISIT"), NULL)
174		#' )
175		#' )
176		#' )
177		#' if (interactive()) {
178		#' shinyApp(app$ui, app$server)
179		#' }
180		#'
181		#' @export
182		tm_a_gee <- function(label,
183		dataname,
184		parentname = ifelse(
185		inherits(arm_var, "data_extract_spec"),
186		teal.transform::datanames_input(arm_var),
187		"ADSL"
188		),
189		aval_var,
190		id_var,
191		arm_var,
192		visit_var,
193		cov_var,
194		arm_ref_comp = NULL,
195		paramcd,
196		conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE),
197		pre_output = NULL,
198		post_output = NULL,
199		basic_table_args = teal.widgets::basic_table_args()) {
200	!	message("Initializing tm_a_gee (prototype)")
201
202	!	cov_var <- teal.transform::add_no_selected_choices(cov_var, multiple = TRUE)
203
204	!	checkmate::assert_string(label)
205	!	checkmate::assert_string(dataname)
206	!	checkmate::assert_string(parentname)
207	!	checkmate::assert_class(aval_var, "choices_selected")
208	!	checkmate::assert_class(id_var, "choices_selected")
209	!	checkmate::assert_class(arm_var, "choices_selected")
210	!	checkmate::assert_class(visit_var, "choices_selected")
211	!	checkmate::assert_class(cov_var, "choices_selected")
212	!	checkmate::assert_class(paramcd, "choices_selected")
213	!	checkmate::assert_class(conf_level, "choices_selected")
214	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
215	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
216	!	checkmate::assert_class(basic_table_args, "basic_table_args")
217
218	!	args <- as.list(environment())
219
220	!	data_extract_list <- list(
221	!	arm_var = cs_to_des_select(arm_var, dataname = parentname),
222	!	paramcd = cs_to_des_filter(paramcd, dataname = dataname),
223	!	id_var = cs_to_des_select(id_var, dataname = dataname),
224	!	visit_var = cs_to_des_select(visit_var, dataname = dataname),
225	!	cov_var = cs_to_des_select(cov_var, dataname = dataname, multiple = TRUE),
226	!	split_covariates = cs_to_des_select(split_choices(cov_var), dataname = dataname, multiple = TRUE),
227	!	aval_var = cs_to_des_select(aval_var, dataname = dataname)
228		)
229
230	!	teal::module(
231	!	label = label,
232	!	server = srv_gee,
233	!	ui = ui_gee,
234	!	ui_args = c(data_extract_list, args),
235	!	server_args = c(
236	!	data_extract_list,
237	!	list(
238	!	dataname = dataname,
239	!	parentname = parentname,
240	!	arm_ref_comp = arm_ref_comp,
241	!	label = label,
242	!	basic_table_args = basic_table_args
243		)
244		),
245	!	datanames = teal.transform::get_extract_datanames(data_extract_list)
246		)
247		}
248
249		ui_gee <- function(id, ...) {
250	!	a <- list(...) # module args
251
252	!	ns <- NS(id)
253	!	is_single_dataset_value <- teal.transform::is_single_dataset(
254	!	a$arm_var,
255	!	a$paramcd,
256	!	a$id_var,
257	!	a$visit_var,
258	!	a$cov_var,
259	!	a$aval_var
260		)
261
262	!	teal.widgets::standard_layout(
263	!	output = teal.widgets::white_small_well(
264	!	tags$h3(textOutput(ns("gee_title"))),
265	!	teal.widgets::table_with_settings_ui(ns("table"))
266		),
267	!	encoding = tags$div(
268		### Reporter
269	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
270		###
271	!	tags$label("Encodings", class = "text-primary"),
272	!	teal.transform::datanames_input(a[c("arm_var", "paramcd", "id_var", "visit_var", "cov_var", "aval_var")]),
273	!	teal.transform::data_extract_ui(
274	!	id = ns("aval_var"),
275	!	label = "Analysis Variable",
276	!	data_extract_spec = a$aval_var,
277	!	is_single_dataset = is_single_dataset_value
278		),
279	!	teal.transform::data_extract_ui(
280	!	id = ns("paramcd"),
281	!	label = "Select Endpoint",
282	!	data_extract_spec = a$paramcd,
283	!	is_single_dataset = is_single_dataset_value
284		),
285	!	teal.transform::data_extract_ui(
286	!	id = ns("visit_var"),
287	!	label = "Visit Variable",
288	!	data_extract_spec = a$visit_var,
289	!	is_single_dataset = is_single_dataset_value
290		),
291	!	teal.transform::data_extract_ui(
292	!	id = ns("cov_var"),
293	!	label = "Covariates",
294	!	data_extract_spec = a$cov_var,
295	!	is_single_dataset = is_single_dataset_value
296		),
297	!	shinyjs::hidden(
298	!	teal.transform::data_extract_ui(
299	!	id = ns("split_covariates"),
300	!	label = "Split Covariates",
301	!	data_extract_spec = a$split_covariates,
302	!	is_single_dataset = is_single_dataset_value
303		)
304		),
305	!	teal.transform::data_extract_ui(
306	!	id = ns("arm_var"),
307	!	label = "Select Treatment Variable",
308	!	data_extract_spec = a$arm_var,
309	!	is_single_dataset = is_single_dataset_value
310		),
311	!	shinyjs::hidden(
312	!	uiOutput(ns("arms_buckets")),
313	!	helpText(
314	!	id = ns("help_text"), "Multiple reference groups are automatically combined into a single group."
315		),
316	!	checkboxInput(
317	!	ns("combine_comp_arms"),
318	!	"Combine all comparison groups?",
319	!	value = FALSE
320		)
321		),
322	!	teal.transform::data_extract_ui(
323	!	id = ns("id_var"),
324	!	label = "Subject Identifier",
325	!	data_extract_spec = a$id_var,
326	!	is_single_dataset = is_single_dataset_value
327		),
328	!	selectInput(
329	!	ns("cor_struct"),
330	!	"Correlation Structure",
331	!	choices = c(
332	!	"unstructured",
333	!	"toeplitz", # needs the fix of https://github.com/insightsengineering/tern.gee/issues/3
334	!	"auto-regressive",
335	!	"compound symmetry"
336		),
337	!	selected = "unstructured",
338	!	multiple = FALSE
339		),
340	!	teal.widgets::optionalSelectInput(
341	!	ns("conf_level"),
342	!	"Confidence Level",
343	!	a$conf_level$choices,
344	!	a$conf_level$selected,
345	!	multiple = FALSE,
346	!	fixed = a$conf_level$fixed
347		),
348	!	radioButtons(
349	!	ns("output_table"),
350	!	"Output Type",
351	!	choices = c(
352	!	"LS means" = "t_gee_lsmeans",
353	!	"Covariance" = "t_gee_cov",
354	!	"Coefficients" = "t_gee_coef"
355		),
356	!	selected = "t_gee_lsmeans"
357		)
358		),
359	!	forms = tagList(
360	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
361		),
362	!	pre_output = a$pre_output,
363	!	post_output = a$post_output
364		)
365		}
366
367		srv_gee <- function(id,
368		data,
369		filter_panel_api,
370		reporter,
371		dataname,
372		parentname,
373		arm_var,
374		paramcd,
375		id_var,
376		visit_var,
377		cov_var,
378		split_covariates,
379		aval_var,
380		arm_ref_comp,
381		label,
382		plot_height,
383		plot_width,
384		basic_table_args) {
385	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
386	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
387	!	checkmate::assert_class(data, "reactive")
388	!	checkmate::assert_class(isolate(data()), "teal_data")
389
390	!	moduleServer(id, function(input, output, session) {
391	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
392		## split_covariates ----
393	!	observeEvent(input[[extract_input("cov_var", dataname)]],
394	!	ignoreNULL = FALSE,
395		{
396		# update covariates as actual variables
397	!	split_interactions_values <- split_interactions(
398	!	input[[extract_input("cov_var", dataname)]]
399		)
400	!	arm_var_value <- input[[extract_input("arm_var", parentname)]]
401	!	arm_in_cov <- length(intersect(split_interactions_values, arm_var_value)) >= 1L
402	!	if (arm_in_cov) {
403	!	split_covariates_selected <- setdiff(split_interactions_values, arm_var_value)
404		} else {
405	!	split_covariates_selected <- split_interactions_values
406		}
407	!	teal.widgets::updateOptionalSelectInput(
408	!	session,
409	!	inputId = extract_input("split_covariates", dataname),
410	!	selected = split_covariates_selected
411		)
412		}
413		)
414
415		## arm_ref_comp_observer ----
416	!	arm_ref_comp_observer(
417	!	session,
418	!	input,
419	!	output,
420	!	id_arm_var = extract_input("arm_var", parentname),
421	!	data = reactive(data()[[parentname]]),
422	!	arm_ref_comp = arm_ref_comp,
423	!	module = "tm_a_gee"
424		)
425
426		## data_merge_modules ----
427	!	selector_list <- teal.transform::data_extract_multiple_srv(
428	!	data_extract = list(
429	!	arm_var = arm_var,
430	!	paramcd = paramcd,
431	!	id_var = id_var,
432	!	visit_var = visit_var,
433	!	split_covariates = split_covariates,
434	!	aval_var = aval_var
435		),
436	!	datasets = data,
437	!	select_validation_rule = list(
438	!	aval_var = shinyvalidate::sv_required("An analysis variable is required"),
439	!	arm_var = shinyvalidate::sv_required("A treatment variable is required"),
440	!	id_var = shinyvalidate::sv_required("A Subject identifier is required"),
441	!	visit_var = shinyvalidate::sv_required("A visit variable is required")
442		),
443	!	filter_validation_rule = list(
444	!	paramcd = shinyvalidate::sv_required("An endpoint is required")
445		)
446		)
447
448	!	iv_r <- reactive({
449	!	iv <- shinyvalidate::InputValidator$new()
450	!	iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level"))
451	!	iv$add_rule(
452	!	"conf_level",
453	!	shinyvalidate::sv_between(
454	!	0, 1,
455	!	inclusive = c(FALSE, FALSE),
456	!	message_fmt = "Confidence level must be between 0 and 1"
457		)
458		)
459	!	iv$add_rule("cor_struct", shinyvalidate::sv_required("Please choose a correlation structure"))
460	!	teal.transform::compose_and_enable_validators(iv, selector_list)
461		})
462
463	!	anl_inputs <- teal.transform::merge_expression_srv(
464	!	datasets = data,
465	!	selector_list = selector_list,
466	!	merge_function = "dplyr::inner_join"
467		)
468
469	!	adsl_inputs <- teal.transform::merge_expression_module(
470	!	datasets = data,
471	!	data_extract = list(arm_var = arm_var),
472	!	anl_name = "ANL_ADSL"
473		)
474
475	!	anl_q <- reactive({
476	!	data() %>%
477	!	teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
478	!	teal.code::eval_code(as.expression(adsl_inputs()$expr))
479		})
480
481	!	merged <- list(
482	!	anl_input_r = anl_inputs,
483	!	adsl_input_r = adsl_inputs,
484	!	anl_q = anl_q
485		)
486
487		# Initially hide the output title because there is no output yet.
488	!	shinyjs::show("gee_title")
489
490	!	validate_checks <- reactive({
491	!	teal::validate_inputs(iv_r())
492
493		# To do in production: add validations.
494	!	NULL
495		})
496
497		## table_r ----
498	!	table_q <- reactive({
499	!	validate_checks()
500	!	output_table <- input$output_table
501	!	conf_level <- as.numeric(input$conf_level)
502	!	col_source <- merged$anl_input_r()$columns_source
503	!	filter_info <- merged$anl_input_r()$filter_info
504
505	!	req(output_table)
506
507	!	basic_table_args$subtitles <- paste0(
508	!	"Analysis Variable: ", col_source$aval_var,
509	!	", Endpoint: ", filter_info$paramcd[[1]]$selected[[1]],
510	!	ifelse(length(col_source$split_covariates) == 0, "",
511	!	paste(", Covariates:", paste(col_source$split_covariates, collapse = ", "))
512		)
513		)
514	!	basic_table_args$main_footer <- c(paste("Correlation Structure:", input$cor_struct))
515
516	!	my_calls <- template_a_gee(
517	!	output_table = output_table,
518	!	data_model_fit = "ANL",
519	!	dataname_lsmeans = "ANL_ADSL",
520	!	input_arm_var = as.vector(col_source$arm_var),
521	!	conf_level = conf_level,
522	!	aval_var = col_source$aval_var,
523	!	split_covariates = col_source$split_covariates,
524	!	id_var = col_source$id_var,
525	!	arm_var = col_source$arm_var,
526	!	visit_var = col_source$visit_var,
527	!	cor_struct = input$cor_struct,
528	!	basic_table_args = basic_table_args
529		)
530	!	teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
531		})
532
533	!	output$gee_title <- renderText({
534		# Input on output type.
535	!	output_table <- input$output_table
536
537	!	output_title <- switch(output_table,
538	!	"t_gee_cov" = "Residual Covariance Matrix Estimate",
539	!	"t_gee_coef" = "Model Coefficients",
540	!	"t_gee_lsmeans" = "LS Means Estimates"
541		)
542	!	output_title
543		})
544
545	!	table_r <- reactive({
546	!	table_q()[["result_table"]]
547		})
548
549	!	teal.widgets::table_with_settings_srv(
550	!	id = "table",
551	!	table_r = table_r
552		)
553
554		# Render R code
555	!	teal.widgets::verbatim_popup_srv(
556	!	id = "rcode",
557	!	verbatim_content = reactive(teal.code::get_code(table_q())),
558	!	title = label
559		)
560
561		### REPORTER
562	!	if (with_reporter) {
563	!	card_fun <- function(comment, label) {
564	!	card <- teal::report_card_template(
565	!	title = "Generalized Estimating Equations (GEE) Analysis Table",
566	!	label = label,
567	!	with_filter = with_filter,
568	!	filter_panel_api = filter_panel_api
569		)
570	!	table_type <- switch(input$output_table,
571	!	"t_gee_cov" = "Residual Covariance Matrix Estimate",
572	!	"t_gee_coef" = "Model Coefficients",
573	!	"t_gee_lsmeans" = "LS Means Estimates"
574		)
575	!	card$append_text(paste(table_type, "Table"), "header3")
576	!	card$append_table(table_r())
577	!	if (!comment == "") {
578	!	card$append_text("Comment", "header3")
579	!	card$append_text(comment)
580		}
581	!	card$append_src(teal.code::get_code(table_q()))
582	!	card
583		}
584	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
585		}
586		})
587		}

1		#' Template: Patient Profile Medical History
2		#'
3		#' Creates a valid expression to generate a patient profile medical history report using ADaM datasets.
4		#'
5		#' @inheritParams template_arguments
6		#' @param mhterm (`character`)\cr name of the reported term for the medical history variable.
7		#' @param mhbodsys (`character`)\cr name of the body system or organ class variable.
8		#' @param mhdistat (`character`)\cr name of the status of the disease variable.
9		#'
10		#' @inherit template_arguments return
11		#'
12		#' @seealso [tm_t_pp_medical_history()]
13		#'
14		#' @keywords internal
15		template_medical_history <- function(dataname = "ANL",
16		mhterm = "MHTERM",
17		mhbodsys = "MHBODSYS",
18		mhdistat = "MHDISTAT",
19		patient_id = NULL) {
20	3x	checkmate::assert_string(dataname)
21	3x	checkmate::assert_string(mhterm)
22	3x	checkmate::assert_string(mhbodsys)
23	3x	checkmate::assert_string(mhdistat)
24
25	3x	y <- list()
26	3x	y$table <- list()
27
28	3x	table_list <- add_expr(
29	3x	list(),
30	3x	substitute(expr = {
31	!	labels <- teal.data::col_labels(dataname, fill = FALSE)[c(mhbodsys_char, mhterm_char, mhdistat_char)]
32	!	mhbodsys_label <- labels[mhbodsys_char]
33
34	!	result_raw <-
35	!	dataname %>%
36	!	dplyr::select(mhbodsys, mhterm, mhdistat) %>%
37	!	dplyr::arrange(mhbodsys) %>%
38	!	dplyr::mutate_if(is.character, as.factor) %>%
39	!	dplyr::mutate_if(is.factor, function(x) explicit_na(x, "UNKNOWN")) %>%
40	!	dplyr::distinct() %>%
41	!	`colnames<-`(labels)
42
43	!	result <- rtables::basic_table() %>%
44	!	rtables::split_cols_by_multivar(colnames(result_raw)[2:3]) %>%
45	!	rtables::split_rows_by(
46	!	colnames(result_raw)[1],
47	!	split_fun = rtables::drop_split_levels
48		) %>%
49	!	rtables::split_rows_by(
50	!	colnames(result_raw)[2],
51	!	split_fun = rtables::drop_split_levels,
52	!	child_labels = "hidden"
53		) %>%
54	!	rtables::analyze_colvars(function(x) x[seq_along(x)]) %>%
55	!	rtables::build_table(result_raw)
56
57	!	main_title(result) <- paste("Patient ID:", patient_id)
58
59	!	result
60	3x	}, env = list(
61	3x	dataname = as.name(dataname),
62	3x	mhbodsys = as.name(mhbodsys),
63	3x	mhterm = as.name(mhterm),
64	3x	mhdistat = as.name(mhdistat),
65	3x	mhbodsys_char = mhbodsys,
66	3x	mhterm_char = mhterm,
67	3x	mhdistat_char = mhdistat,
68	3x	patient_id = patient_id
69		))
70		)
71
72	3x	y$table <- bracket_expr(table_list)
73
74	3x	y
75		}
76
77		#' teal Module: Patient Profile Medical History
78		#'
79		#' This module produces a patient profile medical history report using ADaM datasets.
80		#'
81		#' @inheritParams module_arguments
82		#' @inheritParams template_medical_history
83		#' @param mhterm ([teal.transform::choices_selected()])\cr object with all
84		#' available choices and preselected option for the `MHTERM` variable from `dataname`.
85		#' @param mhbodsys ([teal.transform::choices_selected()])\cr object with all
86		#' available choices and preselected option for the `MHBODSYS` variable from `dataname`.
87		#' @param mhdistat ([teal.transform::choices_selected()])\cr object with all
88		#' available choices and preselected option for the `MHDISTAT` variable from `dataname`.
89		#'
90		#' @inherit module_arguments return
91		#'
92		#' @examples
93		#' ADSL <- tmc_ex_adsl
94		#' ADMH <- tmc_ex_admh
95		#'
96		#' app <- init(
97		#' data = cdisc_data(
98		#' ADSL = ADSL,
99		#' ADMH = ADMH,
100		#' code = "
101		#' ADSL <- tmc_ex_adsl
102		#' ADMH <- tmc_ex_admh
103		#' "
104		#' ),
105		#' modules = modules(
106		#' tm_t_pp_medical_history(
107		#' label = "Medical History",
108		#' dataname = "ADMH",
109		#' parentname = "ADSL",
110		#' patient_col = "USUBJID",
111		#' mhterm = choices_selected(
112		#' choices = variable_choices(ADMH, c("MHTERM")),
113		#' selected = "MHTERM"
114		#' ),
115		#' mhbodsys = choices_selected(
116		#' choices = variable_choices(ADMH, "MHBODSYS"),
117		#' selected = "MHBODSYS"
118		#' ),
119		#' mhdistat = choices_selected(
120		#' choices = variable_choices(ADMH, "MHDISTAT"),
121		#' selected = "MHDISTAT"
122		#' )
123		#' )
124		#' )
125		#' )
126		#' if (interactive()) {
127		#' shinyApp(app$ui, app$server)
128		#' }
129		#'
130		#' @export
131		tm_t_pp_medical_history <- function(label,
132		dataname = "ADMH",
133		parentname = "ADSL",
134		patient_col = "USUBJID",
135		mhterm = NULL,
136		mhbodsys = NULL,
137		mhdistat = NULL,
138		pre_output = NULL,
139		post_output = NULL) {
140	!	message("Initializing tm_t_pp_medical_history")
141	!	checkmate::assert_string(label)
142	!	checkmate::assert_string(dataname)
143	!	checkmate::assert_string(parentname)
144	!	checkmate::assert_string(patient_col)
145	!	checkmate::assert_class(mhterm, "choices_selected", null.ok = TRUE)
146	!	checkmate::assert_class(mhbodsys, "choices_selected", null.ok = TRUE)
147	!	checkmate::assert_class(mhdistat, "choices_selected", null.ok = TRUE)
148	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
149	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
150
151	!	args <- as.list(environment())
152	!	data_extract_list <- list(
153	!	mhterm = `if`(is.null(mhterm), NULL, cs_to_des_select(mhterm, dataname = dataname)),
154	!	mhbodsys = `if`(is.null(mhbodsys), NULL, cs_to_des_select(mhbodsys, dataname = dataname)),
155	!	mhdistat = `if`(is.null(mhdistat), NULL, cs_to_des_select(mhdistat, dataname = dataname))
156		)
157
158	!	module(
159	!	label = label,
160	!	ui = ui_t_medical_history,
161	!	ui_args = c(data_extract_list, args),
162	!	server = srv_t_medical_history,
163	!	server_args = c(
164	!	data_extract_list,
165	!	list(
166	!	dataname = dataname,
167	!	parentname = parentname,
168	!	label = label,
169	!	patient_col = patient_col
170		)
171		),
172	!	datanames = c(dataname, parentname)
173		)
174		}
175
176		#' @keywords internal
177		ui_t_medical_history <- function(id, ...) {
178	!	ui_args <- list(...)
179	!	is_single_dataset_value <- teal.transform::is_single_dataset(
180	!	ui_args$mhterm,
181	!	ui_args$mhbodsys,
182	!	ui_args$mhdistat
183		)
184
185	!	ns <- NS(id)
186	!	teal.widgets::standard_layout(
187	!	output = tags$div(
188	!	teal.widgets::table_with_settings_ui(ns("table"))
189		),
190	!	encoding = tags$div(
191		### Reporter
192	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
193		###
194	!	tags$label("Encodings", class = "text-primary"),
195	!	teal.transform::datanames_input(ui_args[c("mhterm", "mhbodsys", "mhdistat")]),
196	!	teal.widgets::optionalSelectInput(
197	!	ns("patient_id"),
198	!	"Select Patient:",
199	!	multiple = FALSE,
200	!	options = shinyWidgets::pickerOptions(`liveSearch` = TRUE)
201		),
202	!	teal.transform::data_extract_ui(
203	!	id = ns("mhterm"),
204	!	label = "Select MHTERM variable:",
205	!	data_extract_spec = ui_args$mhterm,
206	!	is_single_dataset = is_single_dataset_value
207		),
208	!	teal.transform::data_extract_ui(
209	!	id = ns("mhbodsys"),
210	!	label = "Select MHBODSYS variable:",
211	!	data_extract_spec = ui_args$mhbodsys,
212	!	is_single_dataset = is_single_dataset_value
213		),
214	!	teal.transform::data_extract_ui(
215	!	id = ns("mhdistat"),
216	!	label = "Select MHDISTAT variable:",
217	!	data_extract_spec = ui_args$mhdistat,
218	!	is_single_dataset = is_single_dataset_value
219		)
220		),
221	!	forms = tagList(
222	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
223		),
224	!	pre_output = ui_args$pre_output,
225	!	post_output = ui_args$post_output
226		)
227		}
228
229		#' @keywords internal
230		srv_t_medical_history <- function(id,
231		data,
232		reporter,
233		filter_panel_api,
234		dataname,
235		parentname,
236		patient_col,
237		mhterm,
238		mhbodsys,
239		mhdistat,
240		label) {
241	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
242	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
243	!	checkmate::assert_class(data, "reactive")
244	!	checkmate::assert_class(shiny::isolate(data()), "teal_data")
245
246	!	moduleServer(id, function(input, output, session) {
247	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
248	!	patient_id <- reactive(input$patient_id)
249
250		# Init
251	!	patient_data_base <- reactive(unique(data()[[parentname]][[patient_col]]))
252	!	teal.widgets::updateOptionalSelectInput(
253	!	session, "patient_id",
254	!	choices = patient_data_base(), selected = patient_data_base()[1]
255		)
256
257	!	observeEvent(patient_data_base(),
258	!	handlerExpr = {
259	!	teal.widgets::updateOptionalSelectInput(
260	!	session,
261	!	"patient_id",
262	!	choices = patient_data_base(),
263	!	selected = if (length(patient_data_base()) == 1) {
264	!	patient_data_base()
265		} else {
266	!	intersect(patient_id(), patient_data_base())
267		}
268		)
269		},
270	!	ignoreInit = TRUE
271		)
272
273		# Medical history tab ----
274	!	selector_list <- teal.transform::data_extract_multiple_srv(
275	!	data_extract = list(mhterm = mhterm, mhbodsys = mhbodsys, mhdistat = mhdistat),
276	!	datasets = data,
277	!	select_validation_rule = list(
278	!	mhterm = shinyvalidate::sv_required("Please select MHTERM variable."),
279	!	mhbodsys = shinyvalidate::sv_required("Please select MHBODSYS variable."),
280	!	mhdistat = shinyvalidate::sv_required("Please select MHDISTAT variable.")
281		)
282		)
283
284	!	iv_r <- reactive({
285	!	iv <- shinyvalidate::InputValidator$new()
286	!	iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient"))
287	!	teal.transform::compose_and_enable_validators(iv, selector_list)
288		})
289
290	!	anl_inputs <- teal.transform::merge_expression_srv(
291	!	datasets = data,
292	!	selector_list = selector_list,
293	!	merge_function = "dplyr::left_join"
294		)
295
296	!	anl_q <- reactive({
297	!	data() %>%
298	!	teal.code::eval_code(as.expression(anl_inputs()$expr))
299		})
300
301	!	all_q <- reactive({
302	!	teal::validate_inputs(iv_r())
303
304	!	validate(
305	!	need(
306	!	nrow(anl_q()[["ANL"]][anl_q()[["ANL"]][[patient_col]] == patient_id(), ]) > 0,
307	!	"Patient has no data about medical history."
308		)
309		)
310
311	!	my_calls <- template_medical_history(
312	!	dataname = "ANL",
313	!	mhterm = input[[extract_input("mhterm", dataname)]],
314	!	mhbodsys = input[[extract_input("mhbodsys", dataname)]],
315	!	mhdistat = input[[extract_input("mhdistat", dataname)]],
316	!	patient_id = patient_id()
317		)
318
319	!	teal.code::eval_code(
320	!	anl_q(),
321	!	substitute(
322	!	expr = {
323	!	ANL <- ANL[ANL[[patient_col]] == patient_id, ]
324	!	}, env = list(
325	!	patient_col = patient_col,
326	!	patient_id = patient_id()
327		)
328		)
329		) %>%
330	!	teal.code::eval_code(as.expression(my_calls))
331		})
332
333	!	table_r <- reactive(all_q()[["result"]])
334
335	!	teal.widgets::table_with_settings_srv(
336	!	id = "table",
337	!	table_r = table_r
338		)
339
340	!	teal.widgets::verbatim_popup_srv(
341	!	id = "rcode",
342	!	verbatim_content = reactive(teal.code::get_code(all_q())),
343	!	title = label
344		)
345
346		### REPORTER
347	!	if (with_reporter) {
348	!	card_fun <- function(comment, label) {
349	!	card <- teal::report_card_template(
350	!	title = "Patient Medical History Table",
351	!	label = label,
352	!	with_filter = with_filter,
353	!	filter_panel_api = filter_panel_api
354		)
355	!	card$append_text("Table", "header3")
356	!	card$append_table(table_r())
357	!	if (!comment == "") {
358	!	card$append_text("Comment", "header3")
359	!	card$append_text(comment)
360		}
361	!	card$append_src(teal.code::get_code(all_q()))
362	!	card
363		}
364	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
365		}
366		###
367		})
368		}

1		#' Template: Patient Profile Prior Medication
2		#'
3		#' Creates a valid expression to generate a patient profile prior medication report using ADaM datasets.
4		#'
5		#' @inheritParams template_arguments
6		#'
7		#' @inherit template_arguments return
8		#'
9		#' @seealso [tm_t_pp_prior_medication()]
10		#'
11		#' @keywords internal
12		template_prior_medication <- function(dataname = "ANL",
13		atirel = "ATIREL",
14		cmdecod = "CMDECOD",
15		cmindc = "CMINDC",
16		cmstdy = "CMSTDY") {
17	!	checkmate::assert_string(dataname)
18	!	checkmate::assert_string(atirel)
19	!	checkmate::assert_string(cmdecod)
20	!	checkmate::assert_string(cmindc)
21	!	checkmate::assert_string(cmstdy)
22
23	!	y <- list()
24	!	y$table <- list()
25
26	!	table_list <- add_expr(
27	!	list(),
28	!	substitute(expr = {
29	!	result <-
30	!	dataname %>%
31	!	dplyr::filter(atirel %in% c("PRIOR", "PRIOR_CONCOMITANT")) %>%
32	!	dplyr::select(cmindc, cmdecod, cmstdy) %>%
33	!	dplyr::filter(!is.na(cmdecod)) %>%
34	!	dplyr::distinct() %>%
35	!	`colnames<-`(col_labels(dataname, fill = TRUE)[c(cmindc_char, cmdecod_char, cmstdy_char)])
36	!	result
37	!	}, env = list(
38	!	dataname = as.name(dataname),
39	!	atirel = as.name(atirel),
40	!	cmdecod = as.name(cmdecod),
41	!	cmindc = as.name(cmindc),
42	!	cmstdy = as.name(cmstdy),
43	!	atirel_char = atirel,
44	!	cmdecod_char = cmdecod,
45	!	cmindc_char = cmindc,
46	!	cmstdy_char = cmstdy
47		))
48		)
49		# Note: l_html_concomitant_adcm is still not included since one column is available out of 9
50
51	!	y$table <- bracket_expr(table_list)
52	!	y
53		}
54
55		#' teal Module: Patient Profile Prior Medication
56		#'
57		#' This module produces a patient profile prior medication report using ADaM datasets.
58		#'
59		#' @inheritParams module_arguments
60		#' @inheritParams template_prior_medication
61		#'
62		#' @inherit module_arguments return
63		#'
64		#' @examples
65		#' library(dplyr)
66		#'
67		#' ADCM <- tmc_ex_adcm
68		#' ADSL <- tmc_ex_adsl %>% filter(USUBJID %in% ADCM$USUBJID)
69		#' ADCM$CMASTDTM <- ADCM$ASTDTM
70		#' ADCM$CMAENDTM <- ADCM$AENDTM
71		#' adcm_keys <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4")
72		#'
73		#' join_keys <- default_cdisc_join_keys[c("ADSL", "ADCM")]
74		#' join_keys["ADCM", "ADCM"] <- adcm_keys
75		#'
76		#' app <- init(
77		#' data = cdisc_data(
78		#' ADSL = ADSL,
79		#' ADCM = ADCM,
80		#' code = "
81		#' ADCM <- tmc_ex_adcm
82		#' ADSL <- tmc_ex_adsl %>% filter(USUBJID %in% ADCM$USUBJID)
83		#' ADCM$CMASTDTM <- ADCM$ASTDTM
84		#' ADCM$CMAENDTM <- ADCM$AENDTM
85		#' ",
86		#' join_keys = join_keys
87		#' ),
88		#' modules = modules(
89		#' tm_t_pp_prior_medication(
90		#' label = "Prior Medication",
91		#' dataname = "ADCM",
92		#' parentname = "ADSL",
93		#' patient_col = "USUBJID",
94		#' atirel = choices_selected(
95		#' choices = variable_choices(ADCM, "ATIREL"),
96		#' selected = "ATIREL"
97		#' ),
98		#' cmdecod = choices_selected(
99		#' choices = variable_choices(ADCM, "CMDECOD"),
100		#' selected = "CMDECOD"
101		#' ),
102		#' cmindc = choices_selected(
103		#' choices = variable_choices(ADCM, "CMINDC"),
104		#' selected = "CMINDC"
105		#' ),
106		#' cmstdy = choices_selected(
107		#' choices = variable_choices(ADCM, "ASTDY"),
108		#' selected = "ASTDY"
109		#' )
110		#' )
111		#' )
112		#' )
113		#' if (interactive()) {
114		#' shinyApp(app$ui, app$server)
115		#' }
116		#'
117		#' @export
118		tm_t_pp_prior_medication <- function(label,
119		dataname = "ADCM",
120		parentname = "ADSL",
121		patient_col = "USUBJID",
122		atirel = NULL,
123		cmdecod = NULL,
124		cmindc = NULL,
125		cmstdy = NULL,
126		pre_output = NULL,
127		post_output = NULL) {
128	!	message("Initializing tm_t_pp_prior_medication")
129	!	checkmate::assert_string(label)
130	!	checkmate::assert_string(dataname)
131	!	checkmate::assert_string(parentname)
132	!	checkmate::assert_string(patient_col)
133	!	checkmate::assert_class(atirel, "choices_selected", null.ok = TRUE)
134	!	checkmate::assert_class(cmdecod, "choices_selected", null.ok = TRUE)
135	!	checkmate::assert_class(cmindc, "choices_selected", null.ok = TRUE)
136	!	checkmate::assert_class(cmstdy, "choices_selected", null.ok = TRUE)
137	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
138	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
139
140	!	args <- as.list(environment())
141	!	data_extract_list <- list(
142	!	atirel = `if`(is.null(atirel), NULL, cs_to_des_select(atirel, dataname = dataname)),
143	!	cmdecod = `if`(is.null(cmdecod), NULL, cs_to_des_select(cmdecod, dataname = dataname)),
144	!	cmindc = `if`(is.null(cmindc), NULL, cs_to_des_select(cmindc, dataname = dataname)),
145	!	cmstdy = `if`(is.null(cmstdy), NULL, cs_to_des_select(cmstdy, dataname = dataname))
146		)
147
148	!	module(
149	!	label = label,
150	!	ui = ui_t_prior_medication,
151	!	ui_args = c(data_extract_list, args),
152	!	server = srv_t_prior_medication,
153	!	server_args = c(
154	!	data_extract_list,
155	!	list(
156	!	dataname = dataname,
157	!	parentname = parentname,
158	!	label = label,
159	!	patient_col = patient_col
160		)
161		),
162	!	datanames = c(dataname, parentname)
163		)
164		}
165
166		#' @keywords internal
167		ui_t_prior_medication <- function(id, ...) {
168	!	ui_args <- list(...)
169	!	is_single_dataset_value <- teal.transform::is_single_dataset(
170	!	ui_args$atirel,
171	!	ui_args$cmdecod,
172	!	ui_args$cmindc,
173	!	ui_args$cmstdy
174		)
175
176	!	ns <- NS(id)
177	!	teal.widgets::standard_layout(
178	!	output = tags$div(
179	!	DT::DTOutput(outputId = ns("prior_medication_table"))
180		),
181	!	encoding = tags$div(
182		### Reporter
183	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
184		###
185	!	tags$label("Encodings", class = "text-primary"),
186	!	teal.transform::datanames_input(ui_args[c("atirel", "cmdecod", "cmindc", "cmstdy")]),
187	!	teal.widgets::optionalSelectInput(
188	!	ns("patient_id"),
189	!	"Select Patient:",
190	!	multiple = FALSE,
191	!	options = shinyWidgets::pickerOptions(`liveSearch` = TRUE)
192		),
193	!	teal.transform::data_extract_ui(
194	!	id = ns("cmdecod"),
195	!	label = "Select the medication decoding column:",
196	!	data_extract_spec = ui_args$cmdecod,
197	!	is_single_dataset = is_single_dataset_value
198		),
199	!	teal.transform::data_extract_ui(
200	!	id = ns("atirel"),
201	!	label = "Select ATIREL variable:",
202	!	data_extract_spec = ui_args$atirel,
203	!	is_single_dataset = is_single_dataset_value
204		),
205	!	teal.transform::data_extract_ui(
206	!	id = ns("cmindc"),
207	!	label = "Select CMINDC variable:",
208	!	data_extract_spec = ui_args$cmindc,
209	!	is_single_dataset = is_single_dataset_value
210		),
211	!	teal.transform::data_extract_ui(
212	!	id = ns("cmstdy"),
213	!	label = "Select CMSTDY variable:",
214	!	data_extract_spec = ui_args$cmstdy,
215	!	is_single_dataset = is_single_dataset_value
216		)
217		),
218	!	forms = tagList(
219	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
220		),
221	!	pre_output = ui_args$pre_output,
222	!	post_output = ui_args$post_output
223		)
224		}
225
226		#' @keywords internal
227		srv_t_prior_medication <- function(id,
228		data,
229		reporter,
230		filter_panel_api,
231		dataname,
232		parentname,
233		patient_col,
234		atirel,
235		cmdecod,
236		cmindc,
237		cmstdy,
238		label) {
239	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
240	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
241	!	checkmate::assert_class(data, "reactive")
242	!	checkmate::assert_class(shiny::isolate(data()), "teal_data")
243
244	!	moduleServer(id, function(input, output, session) {
245	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
246	!	patient_id <- reactive(input$patient_id)
247
248	!	selector_list <- teal.transform::data_extract_multiple_srv(
249	!	data_extract = list(
250	!	atirel = atirel,
251	!	cmdecod = cmdecod,
252	!	cmindc = cmindc,
253	!	cmstdy = cmstdy
254		),
255	!	datasets = data,
256	!	select_validation_rule = list(
257	!	atirel = shinyvalidate::sv_required("An ATIREL variable is required"),
258	!	cmdecod = shinyvalidate::sv_required("A medication decoding variable is required"),
259	!	cmindc = shinyvalidate::sv_required("A CMINDC variable is required"),
260	!	cmstdy = shinyvalidate::sv_required("A CMSTDY variable is required")
261		)
262		)
263
264	!	iv_r <- reactive({
265	!	iv <- shinyvalidate::InputValidator$new()
266	!	iv$add_rule("patient_id", shinyvalidate::sv_required("Please select patient id"))
267	!	teal.transform::compose_and_enable_validators(iv, selector_list)
268		})
269
270		# Init
271	!	patient_data_base <- reactive(unique(data()[[parentname]][[patient_col]]))
272	!	teal.widgets::updateOptionalSelectInput(
273	!	session,
274	!	"patient_id",
275	!	choices = patient_data_base(),
276	!	selected = patient_data_base()[1]
277		)
278
279	!	observeEvent(patient_data_base(),
280	!	handlerExpr = {
281	!	teal.widgets::updateOptionalSelectInput(
282	!	session,
283	!	"patient_id",
284	!	choices = patient_data_base(),
285	!	selected = if (length(patient_data_base()) == 1) {
286	!	patient_data_base()
287		} else {
288	!	intersect(patient_id(), patient_data_base())
289		}
290		)
291		},
292	!	ignoreInit = TRUE
293		)
294
295		# Prior medication tab ----
296	!	anl_inputs <- teal.transform::merge_expression_srv(
297	!	datasets = data,
298	!	selector_list = selector_list,
299	!	merge_function = "dplyr::left_join"
300		)
301
302	!	anl_q <- reactive({
303	!	data() %>%
304	!	teal.code::eval_code(as.expression(anl_inputs()$expr))
305		})
306
307	!	all_q <- reactive({
308	!	teal::validate_inputs(iv_r())
309
310	!	my_calls <- template_prior_medication(
311	!	dataname = "ANL",
312	!	atirel = input[[extract_input("atirel", dataname)]],
313	!	cmdecod = input[[extract_input("cmdecod", dataname)]],
314	!	cmindc = input[[extract_input("cmindc", dataname)]],
315	!	cmstdy = input[[extract_input("cmstdy", dataname)]]
316		)
317
318	!	anl_q() %>%
319	!	teal.code::eval_code(
320	!	substitute(
321	!	expr = {
322	!	ANL <- ANL[ANL[[patient_col]] == patient_id, ]
323	!	}, env = list(
324	!	patient_col = patient_col,
325	!	patient_id = patient_id()
326		)
327		)
328		) %>%
329	!	teal.code::eval_code(as.expression(my_calls))
330		})
331
332	!	table_r <- reactive(all_q()[["result"]])
333
334	!	output$prior_medication_table <- DT::renderDataTable(
335	!	expr = table_r(),
336	!	options = list(
337	!	lengthMenu = list(list(-1, 5, 10, 25), list("All", "5", "10", "25"))
338		)
339		)
340
341	!	teal.widgets::verbatim_popup_srv(
342	!	id = "rcode",
343	!	verbatim_content = reactive(teal.code::get_code(all_q())),
344	!	title = label
345		)
346
347	!	if (with_reporter) {
348	!	card_fun <- function(comment, label) {
349	!	card <- teal::report_card_template(
350	!	title = "Patient Prior Medication Table",
351	!	label = label,
352	!	with_filter = with_filter,
353	!	filter_panel_api = filter_panel_api
354		)
355	!	card$append_text("Table", "header3")
356	!	card$append_table(table_r())
357	!	if (!comment == "") {
358	!	card$append_text("Comment", "header3")
359	!	card$append_text(comment)
360		}
361	!	card$append_src(teal.code::get_code(all_q()))
362	!	card
363		}
364	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
365		}
366		###
367		})
368		}

1		#' Template: Patient Profile Basic Info
2		#'
3		#' Creates a valid expression to generate a patient profile basic info report using ADaM datasets.
4		#'
5		#' @inheritParams template_arguments
6		#' @param vars (`character`)\cr names of the variables to be shown in the table.
7		#'
8		#' @inherit template_arguments return
9		#'
10		#' @seealso [tm_t_pp_basic_info()]
11		#'
12		#' @keywords internal
13		template_basic_info <- function(dataname = "ANL",
14		vars,
15		patient_id = NULL) {
16	!	checkmate::assert_string(dataname)
17	!	checkmate::assert_character(vars, min.len = 1)
18
19	!	y <- list()
20	!	y$table <- list()
21
22	!	table_list <- add_expr(
23	!	list(),
24	!	substitute(
25	!	expr = {
26	!	values <- dataname %>%
27	!	dplyr::select(vars) %>%
28		# we are sure that only one row
29	!	utils::head(1) %>%
30	!	t()
31
32	!	key <- col_labels(dataname, fill = TRUE)[rownames(values)]
33
34	!	result <-
35	!	data.frame(var = rownames(values), key = key, value = values) %>%
36	!	dplyr::select(var, key, value) %>%
37	!	dplyr::rename(` ` = var, ` ` = key, ` ` = value)
38
39	!	result <- rlistings::as_listing(
40	!	result,
41	!	default_formatting = list(all = fmt_config(align = "left"))
42		)
43	!	main_title(result) <- paste("Patient ID:", patient_id)
44
45	!	result
46	!	}, env = list(
47	!	dataname = as.name(dataname),
48	!	vars = vars,
49	!	patient_id = patient_id
50		)
51		)
52		)
53	!	y$table <- bracket_expr(table_list)
54
55	!	y
56		}
57
58		#' teal Module: Patient Profile Basic Info
59		#'
60		#' This module produces a patient profile basic info report using ADaM datasets.
61		#'
62		#' @inheritParams module_arguments
63		#' @inheritParams template_basic_info
64		#' @param vars ([teal.transform::choices_selected()])\cr object with all
65		#' available choices and preselected option for variables from `dataname` to show in the table.
66		#'
67		#' @inherit module_arguments return
68		#'
69		#' @examples
70		#' ADSL <- tmc_ex_adsl
71		#'
72		#' app <- init(
73		#' data = cdisc_data(
74		#' ADSL = ADSL,
75		#' code = "ADSL <- tmc_ex_adsl"
76		#' ),
77		#' modules = modules(
78		#' tm_t_pp_basic_info(
79		#' label = "Basic Info",
80		#' dataname = "ADSL",
81		#' patient_col = "USUBJID",
82		#' vars = choices_selected(
83		#' choices = variable_choices(ADSL),
84		#' selected = c("ARM", "AGE", "SEX", "COUNTRY", "RACE", "EOSSTT")
85		#' )
86		#' )
87		#' )
88		#' )
89		#' if (interactive()) {
90		#' shinyApp(app$ui, app$server)
91		#' }
92		#'
93		#' @export
94		tm_t_pp_basic_info <- function(label,
95		dataname = "ADSL",
96		patient_col = "USUBJID",
97		vars = NULL,
98		pre_output = NULL,
99		post_output = NULL) {
100	!	message("Initializing tm_t_pp_basic_info")
101	!	checkmate::assert_string(label)
102	!	checkmate::assert_string(dataname)
103	!	checkmate::assert_string(patient_col)
104	!	checkmate::assert_class(vars, "choices_selected", null.ok = TRUE)
105	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
106	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
107
108	!	args <- as.list(environment())
109	!	data_extract_list <- list(
110	!	vars = `if`(is.null(vars), NULL, cs_to_des_select(vars, dataname = dataname, multiple = TRUE))
111		)
112
113	!	module(
114	!	label = label,
115	!	ui = ui_t_basic_info,
116	!	ui_args = c(data_extract_list, args),
117	!	server = srv_t_basic_info,
118	!	server_args = c(
119	!	data_extract_list,
120	!	list(
121	!	dataname = dataname,
122	!	label = label,
123	!	patient_col = patient_col
124		)
125		),
126	!	datanames = dataname
127		)
128		}
129
130		#' @keywords internal
131		ui_t_basic_info <- function(id, ...) {
132	!	ui_args <- list(...)
133	!	is_single_dataset_value <- teal.transform::is_single_dataset(ui_args$vars)
134
135	!	ns <- NS(id)
136	!	teal.widgets::standard_layout(
137	!	output = tags$div(
138	!	htmlOutput(ns("title")),
139	!	DT::DTOutput(outputId = ns("basic_info_table"))
140		),
141	!	encoding = tags$div(
142		### Reporter
143	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
144		###
145	!	tags$label("Encodings", class = "text-primary"),
146	!	teal.transform::datanames_input(ui_args[c("vars")]),
147	!	teal.widgets::optionalSelectInput(
148	!	ns("patient_id"),
149	!	"Select Patient:",
150	!	multiple = FALSE,
151	!	options = shinyWidgets::pickerOptions(`liveSearch` = TRUE)
152		),
153	!	teal.transform::data_extract_ui(
154	!	id = ns("vars"),
155	!	label = "Select variable:",
156	!	data_extract_spec = ui_args$vars,
157	!	is_single_dataset = is_single_dataset_value
158		)
159		),
160	!	forms = tagList(
161	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
162		),
163	!	pre_output = ui_args$pre_output,
164	!	post_output = ui_args$post_output
165		)
166		}
167
168		#' @keywords internal
169		srv_t_basic_info <- function(id,
170		data,
171		reporter,
172		filter_panel_api,
173		dataname,
174		patient_col,
175		vars,
176		label) {
177	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
178	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
179	!	checkmate::assert_class(data, "reactive")
180	!	checkmate::assert_class(shiny::isolate(data()), "teal_data")
181
182	!	moduleServer(id, function(input, output, session) {
183	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
184	!	patient_id <- reactive(input$patient_id)
185
186		# Init
187	!	patient_data_base <- reactive(unique(data()[[dataname]][[patient_col]]))
188	!	teal.widgets::updateOptionalSelectInput(
189	!	session,
190	!	"patient_id",
191	!	choices = patient_data_base(),
192	!	selected = patient_data_base()[1]
193		)
194
195	!	observeEvent(patient_data_base(),
196	!	handlerExpr = {
197	!	teal.widgets::updateOptionalSelectInput(
198	!	session,
199	!	"patient_id",
200	!	choices = patient_data_base(),
201	!	selected = if (length(patient_data_base()) == 1) {
202	!	patient_data_base()
203		} else {
204	!	intersect(patient_id(), patient_data_base())
205		}
206		)
207		},
208	!	ignoreInit = TRUE
209		)
210
211		# Basic Info tab ----
212	!	selector_list <- teal.transform::data_extract_multiple_srv(
213	!	data_extract = list(vars = vars),
214	!	datasets = data,
215	!	select_validation_rule = list(
216	!	vars = shinyvalidate::sv_required("Please select basic info variables")
217		)
218		)
219
220	!	iv_r <- reactive({
221	!	iv <- shinyvalidate::InputValidator$new()
222	!	iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient"))
223	!	teal.transform::compose_and_enable_validators(iv, selector_list)
224		})
225
226	!	anl_inputs <- teal.transform::merge_expression_srv(
227	!	datasets = data,
228	!	selector_list = selector_list,
229	!	merge_function = "dplyr::left_join"
230		)
231
232	!	anl_q <- reactive({
233	!	data() %>%
234	!	teal.code::eval_code(as.expression(anl_inputs()$expr))
235		})
236
237	!	all_q <- reactive({
238	!	teal::validate_inputs(iv_r())
239	!	my_calls <- template_basic_info(
240	!	dataname = "ANL",
241	!	vars = anl_inputs()$columns_source$vars,
242	!	patient_id = patient_id()
243		)
244
245	!	teal.code::eval_code(
246	!	anl_q(),
247	!	substitute(
248	!	expr = {
249	!	pt_id <- patient_id
250	!	ANL <- ANL[ANL[[patient_col]] == patient_id, ]
251	!	}, env = list(
252	!	patient_col = patient_col,
253	!	patient_id = patient_id()
254		)
255		)
256		) %>%
257	!	teal.code::eval_code(as.expression(my_calls))
258		})
259
260	!	output$title <- renderText({
261	!	paste("<h5><b>Patient ID:", all_q()[["pt_id"]], "</b></h5>")
262		})
263
264	!	table_r <- reactive(all_q()[["result"]])
265
266	!	output$basic_info_table <- DT::renderDataTable(
267	!	expr = table_r(),
268	!	options = list(
269	!	lengthMenu = list(list(-1, 5, 10, 25), list("All", "5", "10", "25"))
270		)
271		)
272
273	!	teal.widgets::verbatim_popup_srv(
274	!	id = "rcode",
275	!	verbatim_content = reactive(teal.code::get_code(all_q())),
276	!	title = label
277		)
278
279		### REPORTER
280	!	if (with_reporter) {
281	!	card_fun <- function(comment, label) {
282	!	card <- teal::report_card_template(
283	!	title = "Patient Profile Basic Info Table",
284	!	label = label,
285	!	with_filter = with_filter,
286	!	filter_panel_api = filter_panel_api
287		)
288	!	card$append_text("Table", "header3")
289	!	card$append_table(table_r())
290	!	if (!comment == "") {
291	!	card$append_text("Comment", "header3")
292	!	card$append_text(comment)
293		}
294	!	card$append_src(teal.code::get_code(all_q()))
295	!	card
296		}
297	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
298		}
299		###
300		})
301		}

1		#' Template: Shift by Arm by Worst Analysis Indicator Level
2		#'
3		#' Creates a valid expression to generate a summary table of worst analysis indicator variable level per subject by arm.
4		#'
5		#' @inheritParams template_shift_by_arm
6		#' @inheritParams template_arguments
7		#' @param worst_flag (`character`)\cr value indicating worst analysis indicator level.
8		#'
9		#' @inherit template_arguments return
10		#'
11		#' @seealso [tm_t_shift_by_arm()]
12		#'
13		#' @keywords internal
14		template_shift_by_arm_by_worst <- function(dataname,
15		parentname,
16		arm_var = "ARM",
17		paramcd = "PARAMCD",
18		worst_flag_var = "WORS02FL",
19		worst_flag = "Y",
20		treatment_flag_var = "ONTRTFL",
21		treatment_flag = "Y",
22		aval_var = "ANRIND",
23		base_var = lifecycle::deprecated(),
24		baseline_var = "BNRIND",
25		na.rm = FALSE, # nolint: object_name.
26		na_level = default_na_str(),
27		add_total = FALSE,
28		total_label = default_total_label(),
29		basic_table_args = teal.widgets::basic_table_args()) {
30	3x	if (lifecycle::is_present(base_var)) {
31	!	baseline_var <- base_var
32	!	warning(
33	!	"The `base_var` argument of `template_shift_by_arm_by_worst()` ",
34	!	"is deprecated as of teal.modules.clinical 0.8.16. ",
35	!	"Please use the `baseline_var` argument instead.",
36	!	call. = FALSE
37		)
38		}
39
40	3x	checkmate::assert_string(dataname)
41	3x	checkmate::assert_string(parentname)
42	3x	checkmate::assert_string(arm_var)
43	3x	checkmate::assert_character(worst_flag_var, null.ok = TRUE)
44	3x	checkmate::assert_string(paramcd)
45	3x	checkmate::assert_string(aval_var)
46	3x	checkmate::assert_string(baseline_var)
47	3x	checkmate::assert_flag(na.rm)
48	3x	checkmate::assert_string(na_level)
49	3x	checkmate::assert_string(treatment_flag_var)
50	3x	checkmate::assert_string(treatment_flag)
51	3x	checkmate::assert_flag(add_total)
52	3x	checkmate::assert_string(total_label)
53
54	3x	y <- list()
55
56		# Start data steps.
57	3x	data_list <- list()
58	3x	data_list <- add_expr(
59	3x	data_list,
60	3x	substitute(
61	3x	expr = parentname <- df_explicit_na(parentname, na_level = na_str),
62	3x	env = list(parentname = as.name(parentname), na_str = na_level)
63		)
64		)
65
66	3x	data_list <- add_expr(
67	3x	data_list,
68	3x	substitute(
69	3x	expr = dataname <- df_explicit_na(dataname, na_level = na_str) %>%
70	3x	dplyr::filter(treatment_flag_var == treatment_flag, worst_flag_var == worst_flag) %>%
71	3x	dplyr::mutate(postbaseline_label = "Post-Baseline"),
72	3x	env = list(
73	3x	dataname = as.name(dataname),
74	3x	na_str = na_level,
75	3x	treatment_flag_var = as.name(treatment_flag_var),
76	3x	treatment_flag = treatment_flag,
77	3x	worst_flag_var = as.name(worst_flag_var),
78	3x	worst_flag = worst_flag
79		)
80		)
81		)
82
83	3x	data_list <- add_expr(
84	3x	data_list,
85	3x	substitute(
86	3x	expr = attr(dataname$baseline_var, "label") <- "Baseline Assessment",
87	3x	env = list(dataname = as.name(dataname), baseline_var = baseline_var)
88		)
89		)
90
91	3x	y$data <- bracket_expr(data_list)
92
93	3x	basic_table_args$title <- "Shift by Arm by Worst Table"
94
95	3x	parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
96	3x	teal.widgets::resolve_basic_table_args(
97	3x	user_table = basic_table_args
98		)
99		)
100
101		# Start layout steps.
102	3x	layout_list <- list()
103
104
105	3x	if (add_total) {
106	1x	layout_list <- add_expr(
107	1x	layout_list,
108	1x	substitute(
109	1x	expr = expr_basic_table_args %>%
110	1x	rtables::split_cols_by("postbaseline_label", split_fun = drop_split_levels) %>%
111	1x	rtables::split_cols_by(aval_var) %>%
112	1x	rtables::split_rows_by(
113	1x	arm_var,
114	1x	split_fun = add_overall_level(total_label, first = FALSE),
115	1x	label_pos = "topleft",
116	1x	split_label = obj_label(dataname$arm_var)
117		) %>%
118	1x	add_rowcounts() %>%
119	1x	analyze_vars(
120	1x	baseline_var,
121	1x	denom = "N_row",
122	1x	na_str = na_str,
123	1x	na.rm = na.rm,
124	1x	.stats = "count_fraction"
125		) %>%
126	1x	append_varlabels(dataname, baseline_var, indent = 1L),
127	1x	env = list(
128	1x	aval_var = aval_var,
129	1x	arm_var = arm_var,
130	1x	baseline_var = baseline_var,
131	1x	dataname = as.name(dataname),
132	1x	na.rm = na.rm,
133	1x	na_str = na_level,
134	1x	total_label = total_label,
135	1x	expr_basic_table_args = parsed_basic_table_args
136		)
137		)
138		)
139		} else {
140	2x	layout_list <- add_expr(
141	2x	layout_list,
142	2x	substitute(
143	2x	expr = expr_basic_table_args %>%
144	2x	rtables::split_cols_by("postbaseline_label", split_fun = drop_split_levels) %>%
145	2x	rtables::split_cols_by(aval_var) %>%
146	2x	rtables::split_rows_by(
147	2x	arm_var,
148	2x	split_fun = drop_split_levels,
149	2x	label_pos = "topleft",
150	2x	split_label = obj_label(dataname$arm_var)
151		) %>%
152	2x	add_rowcounts() %>%
153	2x	analyze_vars(
154	2x	baseline_var,
155	2x	denom = "N_row",
156	2x	na_str = na_str,
157	2x	na.rm = na.rm,
158	2x	.stats = "count_fraction"
159		) %>%
160	2x	append_varlabels(dataname, baseline_var, indent = 1L),
161	2x	env = list(
162	2x	aval_var = aval_var,
163	2x	arm_var = arm_var,
164	2x	baseline_var = baseline_var,
165	2x	dataname = as.name(dataname),
166	2x	na.rm = na.rm,
167	2x	na_str = na_level,
168	2x	expr_basic_table_args = parsed_basic_table_args
169		)
170		)
171		)
172		}
173
174	3x	y$layout <- substitute(
175	3x	expr = lyt <- layout_pipe,
176	3x	env = list(layout_pipe = pipe_expr(layout_list))
177		)
178
179		# Full table.
180	3x	y$table <- substitute(
181	3x	expr = {
182	!	result <- rtables::build_table(lyt = lyt, df = dataname)
183	!	result
184		},
185	3x	env = list(dataname = as.name(dataname))
186		)
187
188	3x	y
189		}
190
191		#' teal Module: Shift by Arm by Worst Analysis Indicator Level
192		#'
193		#' This module produces a summary table of worst analysis indicator variable level per subject by arm.
194		#'
195		#' @inheritParams module_arguments
196		#' @inheritParams template_shift_by_arm_by_worst
197		#'
198		#' @inherit module_arguments return
199		#'
200		#' @examples
201		#' ADSL <- tmc_ex_adsl
202		#' ADEG <- tmc_ex_adeg
203		#'
204		#' app <- init(
205		#' data = cdisc_data(
206		#' ADSL = ADSL,
207		#' ADEG = ADEG,
208		#' code = "
209		#' ADSL <- tmc_ex_adsl
210		#' ADEG <- tmc_ex_adeg
211		#' "
212		#' ),
213		#' modules = modules(
214		#' tm_t_shift_by_arm_by_worst(
215		#' label = "Shift by Arm Table",
216		#' dataname = "ADEG",
217		#' arm_var = choices_selected(
218		#' variable_choices(ADSL, subset = c("ARM", "ARMCD")),
219		#' selected = "ARM"
220		#' ),
221		#' paramcd = choices_selected(
222		#' value_choices(ADEG, "PARAMCD"),
223		#' selected = "ECGINTP"
224		#' ),
225		#' worst_flag_var = choices_selected(
226		#' variable_choices(ADEG, c("WORS02FL", "WORS01FL")),
227		#' selected = "WORS02FL"
228		#' ),
229		#' worst_flag = choices_selected(
230		#' value_choices(ADEG, "WORS02FL"),
231		#' selected = "Y", fixed = TRUE
232		#' ),
233		#' aval_var = choices_selected(
234		#' variable_choices(ADEG, c("AVALC", "ANRIND")),
235		#' selected = "AVALC"
236		#' ),
237		#' baseline_var = choices_selected(
238		#' variable_choices(ADEG, c("BASEC", "BNRIND")),
239		#' selected = "BASEC"
240		#' ),
241		#' useNA = "ifany"
242		#' )
243		#' )
244		#' )
245		#' if (interactive()) {
246		#' shinyApp(app$ui, app$server)
247		#' }
248		#'
249		#' @export
250		tm_t_shift_by_arm_by_worst <- function(label,
251		dataname,
252		parentname = ifelse(
253		inherits(arm_var, "data_extract_spec"),
254		teal.transform::datanames_input(arm_var),
255		"ADSL"
256		),
257		arm_var,
258		paramcd,
259		aval_var,
260		base_var = lifecycle::deprecated(),
261		baseline_var,
262		worst_flag_var,
263		worst_flag,
264		treatment_flag_var = teal.transform::choices_selected(
265		choices = teal.transform::variable_choices(dataname, subset = "ONTRTFL"),
266		selected = "ONTRTFL"
267		),
268		treatment_flag = teal.transform::choices_selected("Y"),
269		useNA = c("ifany", "no"), # nolint: object_name.
270		na_level = default_na_str(),
271		add_total = FALSE,
272		total_label = default_total_label(),
273		pre_output = NULL,
274		post_output = NULL,
275		basic_table_args = teal.widgets::basic_table_args()) {
276	!	if (lifecycle::is_present(base_var)) {
277	!	baseline_var <- base_var
278	!	warning(
279	!	"The `base_var` argument of `tm_t_shift_by_arm_by_worst()` is deprecated as of teal.modules.clinical 0.8.16. ",
280	!	"Please use the `baseline_var` argument instead.",
281	!	call. = FALSE
282		)
283		} else {
284	!	base_var <- baseline_var # resolves missing argument error
285		}
286
287	!	message("Initializing tm_t_shift_by_arm_by_worst")
288	!	checkmate::assert_string(label)
289	!	checkmate::assert_string(dataname)
290	!	checkmate::assert_string(parentname)
291	!	useNA <- match.arg(useNA) # nolint: object_name.
292	!	checkmate::assert_string(na_level)
293	!	checkmate::assert_string(total_label)
294	!	checkmate::assert_class(arm_var, "choices_selected")
295	!	checkmate::assert_class(paramcd, "choices_selected")
296	!	checkmate::assert_class(aval_var, "choices_selected")
297	!	checkmate::assert_class(baseline_var, "choices_selected")
298	!	checkmate::assert_class(worst_flag_var, "choices_selected")
299	!	checkmate::assert_class(treatment_flag_var, "choices_selected")
300	!	checkmate::assert_class(treatment_flag, "choices_selected")
301	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
302	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
303	!	checkmate::assert_class(basic_table_args, "basic_table_args")
304	!	args <- as.list(environment())
305
306
307	!	data_extract_list <- list(
308	!	arm_var = cs_to_des_select(arm_var, dataname = parentname),
309	!	paramcd = cs_to_des_filter(paramcd, dataname = dataname),
310	!	treatment_flag_var = cs_to_des_select(treatment_flag_var, dataname = dataname),
311	!	worst_flag_var = cs_to_des_select(worst_flag_var, dataname = dataname),
312	!	aval_var = cs_to_des_select(aval_var, dataname = dataname),
313	!	baseline_var = cs_to_des_select(baseline_var, dataname = dataname)
314		)
315
316
317	!	module(
318	!	label = label,
319	!	server = srv_shift_by_arm_by_worst,
320	!	ui = ui_shift_by_arm_by_worst,
321	!	ui_args = c(data_extract_list, args),
322	!	server_args = c(
323	!	data_extract_list,
324	!	list(
325	!	dataname = dataname,
326	!	parentname = parentname,
327	!	label = label,
328	!	treatment_flag = treatment_flag,
329	!	total_label = total_label,
330	!	na_level = na_level,
331	!	basic_table_args = basic_table_args
332		)
333		),
334	!	datanames = teal.transform::get_extract_datanames(data_extract_list)
335		)
336		}
337
338		#' @keywords internal
339		ui_shift_by_arm_by_worst <- function(id, ...) {
340	!	ns <- NS(id)
341	!	a <- list(...)
342
343	!	is_single_dataset_value <- teal.transform::is_single_dataset(
344	!	a$id_var,
345	!	a$arm_var,
346	!	a$paramcd,
347	!	a$worst_flag_var,
348	!	a$treatment_flag_var,
349	!	a$treatment_flag,
350	!	a$aval_var,
351	!	a$baseline_var
352		)
353	!	teal.widgets::standard_layout(
354	!	output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
355	!	encoding = tags$div(
356		### Reporter
357	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
358		###
359	!	tags$label("Encodings", class = "text-primary"),
360	!	teal.transform::datanames_input(a[c(
361	!	"arm_var", "paramcd_var", "paramcd", "aval_var",
362	!	"baseline_var", "worst_flag_var", "worst_flag", "treamtment_flag_var"
363		)]),
364	!	teal.transform::data_extract_ui(
365	!	id = ns("arm_var"),
366	!	label = "Select Treatment Variable",
367	!	data_extract_spec = a$arm_var,
368	!	is_single_dataset = is_single_dataset_value
369		),
370	!	teal.transform::data_extract_ui(
371	!	id = ns("paramcd"),
372	!	label = "Select Endpoint",
373	!	data_extract_spec = a$paramcd,
374	!	is_single_dataset = is_single_dataset_value
375		),
376	!	teal.transform::data_extract_ui(
377	!	id = ns("worst_flag_var"),
378	!	label = "Select The worst flag",
379	!	data_extract_spec = a$worst_flag_var,
380	!	is_single_dataset = is_single_dataset_value
381		),
382	!	teal.widgets::optionalSelectInput(
383	!	ns("worst_flag"),
384	!	"Value of worst flag",
385	!	a$worst_flag$choices,
386	!	a$worst_flag$selected,
387	!	multiple = FALSE,
388	!	fixed = a$worst_flag$fixed
389		),
390	!	teal.transform::data_extract_ui(
391	!	id = ns("aval_var"),
392	!	label = "Select Analysis Value",
393	!	data_extract_spec = a$aval_var,
394	!	is_single_dataset = is_single_dataset_value
395		),
396	!	teal.transform::data_extract_ui(
397	!	id = ns("baseline_var"),
398	!	label = "Select Baseline Value",
399	!	data_extract_spec = a$baseline_var,
400	!	is_single_dataset = is_single_dataset_value
401		),
402	!	checkboxInput(ns("add_total"), "Add All Patients row", value = a$add_total),
403	!	radioButtons(
404	!	ns("useNA"),
405	!	label = "Display NA counts",
406	!	choices = c("ifany", "no"),
407	!	selected = a$useNA
408		),
409	!	teal.widgets::panel_group(
410	!	teal.widgets::panel_item(
411	!	"Additional Variables Info",
412	!	teal.transform::data_extract_ui(
413	!	id = ns("treatment_flag_var"),
414	!	label = "On Treatment Flag Variable",
415	!	data_extract_spec = a$treatment_flag_var,
416	!	is_single_dataset = is_single_dataset_value
417		),
418	!	teal.widgets::optionalSelectInput(
419	!	inputId = ns("treatment_flag"),
420	!	label = "Value Indicating On Treatment",
421	!	multiple = FALSE,
422	!	fixed_on_single = TRUE
423		)
424		)
425		)
426		),
427	!	forms = tagList(
428	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
429		),
430	!	pre_output = a$pre_output,
431	!	post_output = a$post_output
432		)
433		}
434
435		#' @keywords internal
436		srv_shift_by_arm_by_worst <- function(id,
437		data,
438		reporter,
439		filter_panel_api,
440		dataname,
441		parentname,
442		arm_var,
443		paramcd,
444		treatment_flag_var,
445		treatment_flag,
446		worst_flag_var,
447		aval_var,
448		baseline_var,
449		label,
450		na_level,
451		add_total,
452		total_label,
453		basic_table_args) {
454	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
455	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
456	!	checkmate::assert_class(data, "reactive")
457	!	checkmate::assert_class(shiny::isolate(data()), "teal_data")
458	!	moduleServer(id, function(input, output, session) {
459	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
460	!	selector_list <- teal.transform::data_extract_multiple_srv(
461	!	data_extract = list(
462	!	arm_var = arm_var,
463	!	treatment_flag_var = treatment_flag_var,
464	!	worst_flag_var = worst_flag_var,
465	!	aval_var = aval_var,
466	!	baseline_var = baseline_var,
467	!	paramcd = paramcd
468		),
469	!	datasets = data,
470	!	select_validation_rule = list(
471	!	arm_var = shinyvalidate::sv_required("A treatment variable is required"),
472	!	treatment_flag_var = shinyvalidate::sv_required("A treatment flag variable is required"),
473	!	worst_flag_var = shinyvalidate::sv_required("A worst flag variable is required"),
474	!	aval_var = shinyvalidate::sv_required("An analysis range indicator required"),
475	!	baseline_var = shinyvalidate::sv_required("A baseline reference range indicator is required")
476		),
477	!	filter_validation_rule = list(
478	!	paramcd = shinyvalidate::sv_required("An endpoint is required")
479		)
480		)
481
482	!	isolate({
483	!	resolved <- teal.transform::resolve_delayed(treatment_flag, as.list(data()@env))
484	!	teal.widgets::updateOptionalSelectInput(
485	!	session = session,
486	!	inputId = "treatment_flag",
487	!	choices = resolved$choices,
488	!	selected = resolved$selected
489		)
490		})
491
492	!	iv_r <- reactive({
493	!	iv <- shinyvalidate::InputValidator$new()
494	!	iv$add_rule(
495	!	"treatment_flag",
496	!	shinyvalidate::sv_required("An indicator value for on treatment records is required")
497		)
498	!	teal.transform::compose_and_enable_validators(iv, selector_list)
499		})
500
501	!	anl_inputs <- teal.transform::merge_expression_srv(
502	!	datasets = data,
503	!	selector_list = selector_list,
504	!	merge_function = "dplyr::inner_join"
505		)
506
507	!	adsl_inputs <- teal.transform::merge_expression_module(
508	!	datasets = data,
509	!	data_extract = list(arm_var = arm_var),
510	!	anl_name = "ANL_ADSL"
511		)
512
513	!	anl_q <- reactive({
514	!	data() %>%
515	!	teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
516	!	teal.code::eval_code(as.expression(adsl_inputs()$expr))
517		})
518
519	!	merged <- list(
520	!	anl_input_r = anl_inputs,
521	!	adsl_input_r = adsl_inputs,
522	!	anl_q = anl_q
523		)
524
525		# validate inputs
526	!	validate_checks <- reactive({
527	!	teal::validate_inputs(iv_r())
528
529	!	adsl_filtered <- merged$anl_q()[[parentname]]
530	!	anl_filtered <- merged$anl_q()[[dataname]]
531
532	!	input_arm_var <- names(merged$anl_input_r()$columns_source$arm_var)
533	!	input_aval_var <- names(merged$anl_input_r()$columns_source$aval_var)
534	!	input_baseline_var <- names(merged$anl_input_r()$columns_source$baseline_var)
535
536	!	validate(
537	!	need(
538	!	nrow(merged$anl_q()[["ANL"]]) > 0,
539	!	paste0(
540	!	"Please make sure the analysis dataset is not empty or\n",
541	!	"endpoint parameter and analysis visit are selected."
542		)
543		),
544	!	need(
545	!	length(unique(merged$anl_q()[["ANL"]][[input_aval_var]])) < 50,
546	!	paste(
547	!	"There are too many values of", input_aval_var, "for the selected endpoint.",
548	!	"Please select either a different endpoint or a different analysis value."
549		)
550		),
551	!	need(
552	!	length(unique(merged$anl_q()[["ANL"]][[input_baseline_var]])) < 50,
553	!	paste(
554	!	"There are too many values of", input_baseline_var, "for the selected endpoint.",
555	!	"Please select either a different endpoint or a different baseline value."
556		)
557		)
558		)
559
560	!	validate_standard_inputs(
561	!	adsl = adsl_filtered,
562	!	adslvars = c("USUBJID", "STUDYID", input_arm_var),
563	!	anl = anl_filtered,
564	!	anlvars = c("USUBJID", "STUDYID", input_aval_var, input_baseline_var),
565	!	arm_var = input_arm_var
566		)
567		})
568
569		# generate r code for the analysis
570	!	all_q <- reactive({
571	!	validate_checks()
572
573	!	my_calls <- template_shift_by_arm_by_worst(
574	!	dataname = "ANL",
575	!	parentname = "ANL_ADSL",
576	!	arm_var = names(merged$anl_input_r()$columns_source$arm_var),
577	!	paramcd = unlist(paramcd$filter)["vars_selected"],
578	!	worst_flag_var = names(merged$anl_input_r()$columns_source$worst_flag_var),
579	!	worst_flag = input$worst_flag,
580	!	treatment_flag_var = names(merged$anl_input_r()$columns_source$treatment_flag_var),
581	!	treatment_flag = input$treatment_flag,
582	!	aval_var = names(merged$anl_input_r()$columns_source$aval_var),
583	!	baseline_var = names(merged$anl_input_r()$columns_source$baseline_var),
584	!	na.rm = ifelse(input$useNA == "ifany", FALSE, TRUE),
585	!	na_level = na_level,
586	!	add_total = input$add_total,
587	!	total_label = total_label,
588	!	basic_table_args = basic_table_args
589		)
590
591	!	teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
592		})
593
594		# Outputs to render.
595	!	table_r <- reactive(all_q()[["result"]])
596
597	!	teal.widgets::table_with_settings_srv(
598	!	id = "table",
599	!	table_r = table_r
600		)
601
602		# Render R code.
603	!	teal.widgets::verbatim_popup_srv(
604	!	id = "rcode",
605	!	verbatim_content = reactive(teal.code::get_code(all_q())),
606	!	title = label
607		)
608
609		### REPORTER
610	!	if (with_reporter) {
611	!	card_fun <- function(comment, label) {
612	!	card <- teal::report_card_template(
613	!	title = "Shift by Arm by Worst Table",
614	!	label = label,
615	!	with_filter = with_filter,
616	!	filter_panel_api = filter_panel_api
617		)
618	!	card$append_text("Table", "header3")
619	!	card$append_table(table_r())
620	!	if (!comment == "") {
621	!	card$append_text("Comment", "header3")
622	!	card$append_text(comment)
623		}
624	!	card$append_src(teal.code::get_code(all_q()))
625	!	card
626		}
627	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
628		}
629		###
630		})
631		}

1		#' Template: Adverse Events Table by Standardized MedDRA Query
2		#'
3		#' Creates a valid expression to generate an adverse events table by Standardized MedDRA Query.
4		#'
5		#' @inheritParams template_arguments
6		#' @param smq_varlabel (`character`)\cr label to use for new column `SMQ` created by [tern::h_stack_by_baskets()].
7		#' @param baskets (`character`)\cr names of the selected standardized/customized queries variables.
8		#'
9		#' @inherit template_arguments return
10		#'
11		#' @seealso [tm_t_smq()]
12		#'
13		#' @keywords internal
14		template_smq <- function(dataname,
15		parentname,
16		arm_var,
17		llt = "AEDECOD",
18		add_total = TRUE,
19		total_label = default_total_label(),
20		sort_criteria = c("freq_desc", "alpha"),
21		drop_arm_levels = TRUE,
22		na_level = default_na_str(),
23		smq_varlabel = "Standardized MedDRA Query",
24		baskets = c("SMQ01NAM", "SMQ02NAM", "CQ01NAM"),
25		id_var = "USUBJID",
26		basic_table_args = teal.widgets::basic_table_args()) {
27	2x	checkmate::assert_string(parentname)
28	2x	checkmate::assert_string(dataname)
29	2x	checkmate::assert_character(arm_var, min.len = 1, max.len = 2)
30	2x	checkmate::assert_string(id_var)
31	2x	checkmate::assert_string(llt)
32	2x	checkmate::assert_flag(add_total)
33	2x	checkmate::assert_string(total_label)
34	2x	checkmate::assert_flag(drop_arm_levels)
35	2x	checkmate::assert_string(na_level)
36	2x	checkmate::assert_string(smq_varlabel)
37	2x	checkmate::assert_character(baskets)
38
39	2x	sort_criteria <- match.arg(sort_criteria)
40
41	2x	y <- list()
42
43	2x	data_list <- list()
44
45	2x	data_list <- add_expr(
46	2x	data_list,
47	2x	substitute(
48	2x	anl <- dataname,
49	2x	env = list(
50	2x	dataname = as.name(dataname)
51		)
52		)
53		)
54
55	2x	data_list <- add_expr(
56	2x	data_list,
57	2x	prepare_arm_levels(
58	2x	dataname = "anl",
59	2x	parentname = parentname,
60	2x	arm_var = arm_var[[1]],
61	2x	drop_arm_levels = drop_arm_levels
62		)
63		)
64
65	2x	if (length(arm_var) == 2) {
66	1x	data_list <- add_expr(
67	1x	data_list,
68	1x	prepare_arm_levels(
69	1x	dataname = "anl",
70	1x	parentname = parentname,
71	1x	arm_var = arm_var[[2]],
72	1x	drop_arm_levels = drop_arm_levels
73		)
74		)
75		}
76
77	2x	data_list <- add_expr(
78	2x	data_list,
79	2x	substitute(
80	2x	anl <- h_stack_by_baskets(
81	2x	df = dataname,
82	2x	baskets = baskets,
83	2x	smq_varlabel = smq_varlabel,
84	2x	keys = unique(c("STUDYID", id_var, arm_var, llt))
85		),
86	2x	env = list(
87	2x	dataname = as.name("anl"),
88	2x	baskets = baskets,
89	2x	smq_varlabel = smq_varlabel,
90	2x	id_var = id_var,
91	2x	arm_var = arm_var,
92	2x	llt = llt
93		)
94		)
95		)
96
97	2x	data_list <- add_expr(
98	2x	data_list,
99	2x	quote(
100	2x	if (nrow(anl) == 0) {
101	!	stop("Analysis dataset contains only missing values")
102		}
103		)
104		)
105
106	2x	data_list <- add_expr(
107	2x	data_list,
108	2x	substitute(
109	2x	anl <- df_explicit_na(
110	2x	dataname,
111	2x	na_level = na_str
112		),
113	2x	env = list(
114	2x	dataname = as.name("anl"),
115	2x	na_str = na_level
116		)
117		)
118		)
119
120	2x	data_list <- add_expr(
121	2x	data_list,
122	2x	substitute(
123	2x	parentname <- df_explicit_na(
124	2x	parentname,
125	2x	na_level = na_str
126		),
127	2x	env = list(
128	2x	parentname = as.name(parentname),
129	2x	na_str = na_level
130		)
131		)
132		)
133
134	2x	y$data <- bracket_expr(data_list)
135
136	2x	parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
137	2x	teal.widgets::resolve_basic_table_args(
138	2x	user_table = basic_table_args,
139	2x	module_table = teal.widgets::basic_table_args(show_colcounts = TRUE)
140		)
141		)
142
143		# Start layout steps.
144	2x	layout_list <- list()
145	2x	layout_list <- add_expr(
146	2x	layout_list,
147	2x	substitute(
148	2x	expr = expr_basic_table_args %>%
149	2x	rtables::split_cols_by(var = arm_var),
150	2x	env = list(arm_var = arm_var[[1]], expr_basic_table_args = parsed_basic_table_args)
151		)
152		)
153
154	2x	if (length(arm_var) == 2) {
155	1x	layout_list <- add_expr(
156	1x	layout_list,
157	1x	if (drop_arm_levels) {
158	!	substitute(
159	!	expr = rtables::split_cols_by(var = nested_col, split_fun = drop_split_levels),
160	!	env = list(nested_col = arm_var[[2]])
161		)
162		} else {
163	1x	substitute(
164	1x	expr = rtables::split_cols_by(var = nested_col),
165	1x	env = list(nested_col = arm_var[[2]])
166		)
167		}
168		)
169		}
170
171	2x	if (add_total) {
172	!	layout_list <- add_expr(
173	!	layout_list,
174	!	substitute(
175	!	expr = rtables::add_overall_col(total_label),
176	!	env = list(total_label = total_label)
177		)
178		)
179		}
180
181	2x	layout_list <- add_expr(
182	2x	layout_list,
183	2x	substitute(
184	2x	expr = summarize_num_patients(
185	2x	var = id_var,
186	2x	.stats = c("unique"),
187	2x	.labels = c(
188	2x	unique = "Total number of patients with at least one adverse event"
189		)
190		),
191	2x	env = list(
192	2x	id_var = id_var
193		)
194		)
195		)
196
197	2x	split_label <- substitute(
198	2x	expr = teal.data::col_labels(dataname, fill = FALSE)[["SMQ"]],
199	2x	env = list(
200	2x	dataname = as.name("anl")
201		)
202		)
203
204	2x	layout_list <- add_expr(
205	2x	layout_list,
206	2x	substitute(
207	2x	expr = rtables::split_rows_by(
208	2x	"SMQ",
209	2x	child_labels = "visible",
210	2x	nested = FALSE,
211	2x	split_fun = trim_levels_in_group(llt, drop_outlevs = FALSE),
212	2x	indent_mod = -1L,
213	2x	label_pos = "topleft",
214	2x	split_label = split_label
215		),
216	2x	env = list(
217	2x	llt = llt,
218	2x	split_label = split_label
219		)
220		)
221		)
222
223	2x	layout_list <- add_expr(
224	2x	layout_list,
225	2x	substitute(
226	2x	expr = summarize_num_patients(
227	2x	var = id_var,
228	2x	.stats = c("unique", "nonunique"),
229	2x	.labels = c(
230	2x	unique = "Total number of patients with at least one adverse event",
231	2x	nonunique = "Total number of events"
232		)
233		),
234	2x	env = list(
235	2x	id_var = id_var
236		)
237		)
238		)
239
240	2x	layout_list <- add_expr(
241	2x	layout_list,
242	2x	substitute(
243	2x	expr = count_occurrences(vars = llt, drop = FALSE),
244	2x	env = list(
245	2x	llt = llt
246		)
247		)
248		)
249
250	2x	layout_list <- add_expr(
251	2x	layout_list,
252	2x	substitute(
253	2x	expr = append_varlabels(dataname, llt, indent = 1L),
254	2x	env = list(
255	2x	dataname = as.name("anl"),
256	2x	llt = llt
257		)
258		)
259		)
260
261	2x	y$layout <- substitute(
262	2x	expr = lyt <- layout_pipe,
263	2x	env = list(layout_pipe = pipe_expr(layout_list))
264		)
265
266	2x	y$table <- substitute(
267	2x	expr = {
268	!	result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
269		},
270	2x	env = list(parent = as.name(parentname))
271		)
272
273	2x	if (sort_criteria == "freq_desc") {
274	2x	y$sort <- substitute(
275	2x	expr = {
276	!	sorted_result <- result %>%
277	!	sort_at_path(path = c("SMQ"), scorefun = cont_n_allcols) %>%
278	!	sort_at_path(path = c("SMQ", "*", llt), scorefun = score_occurrences, na.pos = "last")
279		},
280	2x	env = list(llt = llt)
281		)
282		} else {
283	!	y$sort <- quote(
284	!	sorted_result <- result
285		)
286		}
287
288	2x	y$sort_and_prune <- quote(
289	2x	expr = {
290	!	all_zero <- function(tr) {
291	!	!inherits(tr, "ContentRow") && rtables::all_zero_or_na(tr)
292		}
293	!	pruned_and_sorted_result <- sorted_result %>% rtables::trim_rows(criteria = all_zero)
294	!	pruned_and_sorted_result
295		}
296		)
297
298	2x	y
299		}
300
301		#' teal Module: Adverse Events Table by Standardized MedDRA Query
302		#'
303		#' This module produces an adverse events table by Standardized MedDRA Query.
304		#'
305		#' @inheritParams module_arguments
306		#' @inheritParams template_smq
307		#' @param arm_var ([teal.transform::choices_selected()])\cr object with all
308		#' available choices and preselected option for variable names that can be used as `arm_var`.
309		#' It defines the grouping variable(s) in the results table.
310		#' If there are two elements selected for `arm_var`,
311		#' second variable will be nested under the first variable.
312		#' @param baskets ([teal.transform::choices_selected()])\cr object with all
313		#' available choices and preselected options for standardized/customized queries.
314		#' @param scopes ([teal.transform::choices_selected()])\cr object with all
315		#' available choices for the scopes of standardized queries.
316		#'
317		#' @inherit module_arguments return seealso
318		#'
319		#' @examples
320		#' data <- teal_data()
321		#' data <- within(data, {
322		#' ADSL <- tmc_ex_adsl
323		#' ADAE <- tmc_ex_adae
324		#'
325		#' names_baskets <- grep("^(SMQ\|CQ).*NAM$", names(ADAE), value = TRUE)
326		#' names_scopes <- grep("^SMQ.*SC$", names(ADAE), value = TRUE)
327		#'
328		#' cs_baskets <- choices_selected(
329		#' choices = variable_choices(ADAE, subset = names_baskets),
330		#' selected = names_baskets
331		#' )
332		#'
333		#' cs_scopes <- choices_selected(
334		#' choices = variable_choices(ADAE, subset = names_scopes),
335		#' selected = names_scopes,
336		#' fixed = TRUE
337		#' )
338		#' })
339		#'
340		#' datanames <- c("ADSL", "ADAE")
341		#' datanames(data) <- datanames
342		#' join_keys(data) <- default_cdisc_join_keys[datanames]
343		#'
344		#' app <- init(
345		#' data = data,
346		#' modules = modules(
347		#' tm_t_smq(
348		#' label = "Adverse Events by SMQ Table",
349		#' dataname = "ADAE",
350		#' arm_var = choices_selected(
351		#' choices = variable_choices(data[["ADSL"]], subset = c("ARM", "SEX")),
352		#' selected = "ARM"
353		#' ),
354		#' add_total = FALSE,
355		#' baskets = data[["cs_baskets"]],
356		#' scopes = data[["cs_scopes"]],
357		#' llt = choices_selected(
358		#' choices = variable_choices(data[["ADAE"]], subset = c("AEDECOD")),
359		#' selected = "AEDECOD"
360		#' )
361		#' )
362		#' )
363		#' )
364		#' if (interactive()) {
365		#' shinyApp(app$ui, app$server)
366		#' }
367		#'
368		#' @export
369		tm_t_smq <- function(label,
370		dataname,
371		parentname = ifelse(
372		inherits(arm_var, "data_extract_spec"),
373		teal.transform::datanames_input(arm_var),
374		"ADSL"
375		),
376		arm_var,
377		id_var = teal.transform::choices_selected(
378		teal.transform::variable_choices(dataname, subset = "USUBJID"),
379		selected = "USUBJID", fixed = TRUE
380		),
381		llt,
382		add_total = TRUE,
383		total_label = default_total_label(),
384		sort_criteria = c("freq_desc", "alpha"),
385		drop_arm_levels = TRUE,
386		na_level = default_na_str(),
387		smq_varlabel = "Standardized MedDRA Query",
388		baskets,
389		scopes,
390		pre_output = NULL,
391		post_output = NULL,
392		basic_table_args = teal.widgets::basic_table_args()) {
393	!	message("Initializing tm_t_smq")
394	!	checkmate::assert_string(label)
395	!	checkmate::assert_string(dataname)
396	!	checkmate::assert_string(parentname)
397	!	checkmate::assert_class(arm_var, "choices_selected")
398	!	checkmate::assert_class(id_var, "choices_selected")
399	!	checkmate::assert_class(llt, "choices_selected")
400	!	checkmate::assert_class(baskets, "choices_selected")
401	!	checkmate::assert_class(scopes, "choices_selected")
402	!	checkmate::assert_flag(add_total)
403	!	checkmate::assert_string(total_label)
404	!	checkmate::assert_flag(drop_arm_levels)
405	!	sort_criteria <- match.arg(sort_criteria)
406	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
407	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
408	!	checkmate::assert_class(basic_table_args, "basic_table_args")
409
410	!	args <- as.list(environment())
411
412	!	data_extract_list <- list(
413	!	arm_var = cs_to_des_select(arm_var, dataname = parentname, multiple = TRUE, ordered = TRUE),
414	!	id_var = cs_to_des_select(id_var, dataname = dataname),
415	!	baskets = cs_to_des_select(baskets, dataname = dataname, multiple = TRUE),
416	!	scopes = cs_to_des_select(scopes, dataname = dataname, multiple = TRUE),
417	!	llt = cs_to_des_select(llt, dataname = dataname)
418		)
419
420	!	module(
421	!	label = label,
422	!	ui = ui_t_smq,
423	!	server = srv_t_smq,
424	!	ui_args = c(data_extract_list, args),
425	!	server_args = c(
426	!	data_extract_list,
427	!	list(
428	!	dataname = dataname,
429	!	parentname = parentname,
430	!	na_level = na_level,
431	!	label = label,
432	!	total_label = total_label,
433	!	basic_table_args = basic_table_args
434		)
435		),
436	!	datanames = teal.transform::get_extract_datanames(data_extract_list)
437		)
438		}
439
440		#' @keywords internal
441		ui_t_smq <- function(id, ...) {
442	!	ns <- NS(id)
443	!	a <- list(...) # module args
444
445
446	!	is_single_dataset_value <- teal.transform::is_single_dataset(
447	!	a$arm_var,
448	!	a$id_var,
449	!	a$baskets,
450	!	a$scopes,
451	!	a$llt
452		)
453
454	!	teal.widgets::standard_layout(
455	!	output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
456	!	encoding = tags$div(
457		### Reporter
458	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
459		###
460	!	tags$label("Encodings", class = "text-primary"),
461	!	teal.transform::datanames_input(a[c(
462	!	"arm_var", "baskets", "llt", "id_var", "scopes"
463		)]),
464	!	teal.transform::data_extract_ui(
465	!	id = ns("arm_var"),
466	!	label = "Select Treatment Variable",
467	!	data_extract_spec = a$arm_var,
468	!	is_single_dataset = is_single_dataset_value
469		),
470	!	teal.transform::data_extract_ui(
471	!	id = ns("llt"),
472	!	label = "Select the low level term",
473	!	data_extract_spec = a$llt,
474	!	is_single_dataset = is_single_dataset_value
475		),
476	!	checkboxInput(ns("add_total"), "Add All Patients column", value = a$add_total),
477	!	teal.transform::data_extract_ui(
478	!	id = ns("baskets"),
479	!	label = "Select the SMQXXNAM/CQXXNAM baskets",
480	!	data_extract_spec = a$baskets,
481	!	is_single_dataset = is_single_dataset_value
482		),
483	!	teal.widgets::panel_group(
484	!	teal.widgets::panel_item(
485	!	"Additional Variables Info",
486	!	checkboxInput(
487	!	ns(
488	!	"drop_arm_levels"
489		),
490	!	"Drop arm levels not in filtered analysis dataset",
491	!	value = a$drop_arm_levels
492		),
493	!	teal.transform::data_extract_ui(
494	!	id = ns("id_var"),
495	!	label = "Subject Identifier",
496	!	data_extract_spec = a$id_var,
497	!	is_single_dataset = is_single_dataset_value
498		),
499	!	teal.transform::data_extract_ui(
500	!	id = ns("scopes"),
501	!	label = "Scope variables available",
502	!	data_extract_spec = a$scopes,
503	!	is_single_dataset = is_single_dataset_value
504		),
505	!	selectInput(
506	!	inputId = ns("sort_criteria"),
507	!	label = "Sort Criteria",
508	!	choices = c(
509	!	"Decreasing frequency" = "freq_desc",
510	!	"Alphabetically" = "alpha"
511		),
512	!	selected = a$sort_criteria,
513	!	multiple = FALSE
514		)
515		)
516		)
517		),
518	!	forms = tagList(
519	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
520		),
521	!	pre_output = a$pre_output,
522	!	post_output = a$post_output
523		)
524		}
525
526		#' @keywords internal
527		srv_t_smq <- function(id,
528		data,
529		reporter,
530		filter_panel_api,
531		dataname,
532		parentname,
533		arm_var,
534		llt,
535		id_var,
536		baskets,
537		scopes,
538		na_level,
539		label,
540		total_label,
541		basic_table_args) {
542	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
543	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
544	!	checkmate::assert_class(data, "reactive")
545	!	checkmate::assert_class(shiny::isolate(data()), "teal_data")
546	!	moduleServer(id, function(input, output, session) {
547	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
548	!	selector_list <- teal.transform::data_extract_multiple_srv(
549	!	data_extract = list(
550	!	scopes = scopes,
551	!	llt = llt,
552	!	arm_var = arm_var,
553	!	id_var = id_var,
554	!	baskets = baskets
555		),
556	!	datasets = data,
557	!	select_validation_rule = list(
558	!	scopes = shinyvalidate::sv_required("A scope variable is required"),
559	!	llt = shinyvalidate::sv_required("A low level term variable is required"),
560	!	arm_var = shinyvalidate::compose_rules(
561	!	shinyvalidate::sv_required("At least one treatment variable is required"),
562	!	~ if (length(.) > 2) "Please select no more than two treatment variables"
563		),
564	!	id_var = shinyvalidate::sv_required("An id variable is required"),
565	!	baskets = shinyvalidate::sv_required("At least one basket is required")
566		)
567		)
568
569	!	iv_r <- reactive({
570	!	iv <- shinyvalidate::InputValidator$new()
571	!	teal.transform::compose_and_enable_validators(iv, selector_list)
572		})
573
574	!	anl_inputs <- teal.transform::merge_expression_srv(
575	!	datasets = data,
576	!	selector_list = selector_list,
577	!	merge_function = "dplyr::inner_join"
578		)
579
580	!	adsl_inputs <- teal.transform::merge_expression_module(
581	!	datasets = data,
582	!	data_extract = list(arm_var = arm_var),
583	!	anl_name = "ANL_ADSL"
584		)
585
586	!	anl_q <- reactive({
587	!	data() %>%
588	!	teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
589	!	teal.code::eval_code(as.expression(adsl_inputs()$expr))
590		})
591
592	!	merged <- list(
593	!	anl_input_r = anl_inputs,
594	!	adsl_input_r = adsl_inputs,
595	!	anl_q = anl_q
596		)
597
598	!	validate_checks <- reactive({
599	!	teal::validate_inputs(iv_r())
600	!	adsl_filtered <- merged$anl_q()[[parentname]]
601	!	anl_filtered <- merged$anl_q()[[dataname]]
602
603	!	input_arm_var <- names(merged$anl_input_r()$columns_source$arm_var)
604	!	input_id_var <- names(merged$anl_input_r()$columns_source$id_var)
605	!	input_baskets <- names(merged$anl_input_r()$columns_source$baskets)
606	!	input_scopes <- names(merged$anl_input_r()$columns_source$scopes)
607	!	input_llt <- names(merged$anl_input_r()$columns_source$llt)
608
609		# validate inputs
610	!	validate_standard_inputs(
611	!	adsl = adsl_filtered,
612	!	adslvars = c("USUBJID", "STUDYID", input_arm_var),
613	!	anl = anl_filtered,
614	!	anlvars = c(
615	!	"USUBJID", "STUDYID", input_id_var, input_baskets,
616	!	input_scopes, input_llt
617		),
618	!	arm_var = input_arm_var[[1]]
619		)
620		})
621
622	!	all_q <- reactive({
623	!	validate_checks()
624
625	!	my_calls <- template_smq(
626	!	parentname = "ANL_ADSL",
627	!	dataname = "ANL",
628	!	arm_var = names(merged$anl_input_r()$columns_source$arm_var),
629	!	llt = names(merged$anl_input_r()$columns_source$llt),
630	!	add_total = input$add_total,
631	!	total_label = total_label,
632	!	sort_criteria = input$sort_criteria,
633	!	drop_arm_levels = input$drop_arm_levels,
634	!	baskets = names(merged$anl_input_r()$columns_source$baskets),
635	!	na_level = na_level,
636	!	id_var = names(merged$anl_input_r()$columns_source$id_var),
637	!	basic_table_args = basic_table_args
638		)
639
640	!	teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
641		})
642
643		# Outputs to render.
644	!	table_r <- reactive(all_q()[["pruned_and_sorted_result"]])
645
646	!	teal.widgets::table_with_settings_srv(
647	!	id = "table",
648	!	table_r = table_r
649		)
650
651		# Render R code.
652	!	teal.widgets::verbatim_popup_srv(
653	!	id = "rcode",
654	!	verbatim_content = reactive(teal.code::get_code(all_q())),
655	!	title = label
656		)
657
658		### REPORTER
659	!	if (with_reporter) {
660	!	card_fun <- function(comment, label) {
661	!	card <- teal::report_card_template(
662	!	title = "Adverse Events Table by Standardized `MedDRA` Query (SMQ)",
663	!	label = label,
664	!	with_filter = with_filter,
665	!	filter_panel_api = filter_panel_api
666		)
667	!	card$append_text("Table", "header3")
668	!	card$append_table(table_r())
669	!	if (!comment == "") {
670	!	card$append_text("Comment", "header3")
671	!	card$append_text(comment)
672		}
673	!	card$append_src(teal.code::get_code(all_q()))
674	!	card
675		}
676	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
677		}
678		###
679		})
680		}

1		#' Template: Individual Patient Plots
2		#'
3		#' Creates a valid expression to generate [ggplot2::ggplot()] plots of individual patients.
4		#'
5		#' @inheritParams template_arguments
6		#' @param visit_var (`character`)\cr name of the variable for visit timepoints.
7		#' @param add_baseline_hline (`logical`)\cr whether a horizontal line should be added to the plot at baseline y-value.
8		#' @param separate_by_obs (`logical`)\cr whether to create multi-panel plots.
9		#' @param suppress_legend (`logical`)\cr whether to suppress the plot legend.
10		#' @param arm_levels (`character`)\cr vector of all levels of `arm_var`.
11		#' @param avalu_first (`character`)\cr `avalu_var` text to append to the plot title and y-axis label if `add_avalu` is
12		#' `TRUE`.
13		#' @param paramcd_first (`character`)\cr `paramcd` text to append to the plot title and y-axis label.
14		#' @param add_avalu (`logical`)\cr whether `avalu_first` text should be appended to the plot title and y-axis label.
15		#' @param ggplot2_args (`ggplot2_args`) optional\cr object created by [teal.widgets::ggplot2_args()] with settings
16		#' for the module plot. For this module, this argument will only accept `ggplot2_args` object with `labs` list of
17		#' the following child elements: `title`, `subtitle`, `x`, `y`. No other elements are taken into account. The
18		#' argument is merged with option `teal.ggplot2_args` and with default module arguments (hard coded in the module
19		#' body).
20		#'
21		#' For more details, see the vignette: `vignette("custom-ggplot2-arguments", package = "teal.widgets")`.
22		#'
23		#' @inherit template_arguments return
24		#'
25		#' @seealso [tm_g_ipp()]
26		#'
27		#' @keywords internal
28		template_g_ipp <- function(dataname = "ANL",
29		paramcd,
30		arm_var,
31		arm_levels,
32		avalu_first,
33		paramcd_first,
34		aval_var = "AVAL",
35		avalu_var = "AVALU",
36		id_var = "USUBJID",
37		visit_var = "AVISIT",
38		base_var = lifecycle::deprecated(),
39		baseline_var = "BASE",
40		add_baseline_hline = FALSE,
41		separate_by_obs = FALSE,
42		ggplot2_args = teal.widgets::ggplot2_args(),
43		suppress_legend = FALSE,
44		add_avalu = TRUE) {
45	2x	if (lifecycle::is_present(base_var)) {
46	!	baseline_var <- base_var
47	!	warning(
48	!	"The `base_var` argument of `template_g_ipp()` is deprecated as of teal.modules.clinical 0.8.16. ",
49	!	"Please use the `baseline_var` argument instead.",
50	!	call. = FALSE
51		)
52		}
53
54	2x	checkmate::assert_string(dataname)
55	2x	checkmate::assert_string(paramcd)
56	2x	checkmate::assert_string(arm_var)
57	2x	checkmate::assert_string(aval_var)
58	2x	checkmate::assert_string(avalu_var)
59	2x	checkmate::assert_string(id_var)
60	2x	checkmate::assert_string(visit_var)
61	2x	checkmate::assert_string(baseline_var)
62	2x	checkmate::assert_flag(add_baseline_hline)
63	2x	checkmate::assert_flag(separate_by_obs)
64	2x	checkmate::assert_flag(suppress_legend)
65	2x	checkmate::assert_flag(add_avalu)
66
67	2x	y <- list()
68		# Data preprocessing
69
70	2x	y$data <- substitute(
71	2x	expr = anl <- df %>% droplevels(),
72	2x	env = list(df = as.name(dataname))
73		)
74
75	2x	title <- ifelse(
76	2x	add_avalu,
77	2x	sprintf("Individual Patient Plot for %s Values (%s) over Time", paramcd_first, avalu_first),
78	2x	sprintf("Individual Patient Plot for %s Values over Time", paramcd_first)
79		)
80	2x	y_axis <- ifelse(
81	2x	add_avalu,
82	2x	sprintf("%s (%s)", paramcd_first, avalu_first),
83	2x	paramcd_first
84		)
85
86	2x	all_ggplot2_args <- teal.widgets::resolve_ggplot2_args(
87	2x	user_plot = ggplot2_args,
88	2x	module_plot = teal.widgets::ggplot2_args(
89	2x	labs = list(
90	2x	title = title,
91	2x	x = "Visit",
92	2x	y = y_axis,
93	2x	subtitle = paste(arm_levels, collapse = ", ")
94		)
95		)
96		)
97
98	2x	graph_list <- list()
99	2x	graph_list <- add_expr(
100	2x	graph_list,
101	2x	substitute(
102	2x	expr = {
103	!	plot <- h_g_ipp(
104	!	df = anl,
105	!	xvar = visit,
106	!	yvar = aval,
107	!	xlab = xlab_val,
108	!	ylab = ylab_val,
109	!	title = title_val,
110	!	subtitle = subtitle_val,
111	!	id_var = id,
112	!	add_baseline_hline = add_baseline_hline,
113	!	yvar_baseline = base
114		)
115		},
116	2x	env = list(
117	2x	xlab_val = all_ggplot2_args$labs$x,
118	2x	ylab_val = all_ggplot2_args$labs$y,
119	2x	title_val = all_ggplot2_args$labs$title,
120	2x	subtitle_val = all_ggplot2_args$labs$subtitle,
121	2x	paramcd = paramcd,
122	2x	visit = visit_var,
123	2x	aval = aval_var,
124	2x	id = id_var,
125	2x	add_baseline_hline = add_baseline_hline,
126	2x	base = baseline_var,
127	2x	avalu = avalu_var,
128	2x	arm = arm_var
129		)
130		)
131		)
132
133	2x	if (separate_by_obs) {
134	1x	graph_list <- add_expr(
135	1x	graph_list,
136	1x	substitute(
137	1x	expr = plot <- plot + ggplot2::facet_grid(rows = ggplot2::vars(id)),
138	1x	env = list(id = as.name(id_var))
139		)
140		)
141		}
142
143	2x	if (suppress_legend) {
144	!	graph_list <- add_expr(
145	!	graph_list,
146	!	substitute(
147	!	expr = {
148	!	plot <- plot + ggplot2::theme(legend.position = "none")
149		},
150	!	env = list(id = as.name(id_var))
151		)
152		)
153		}
154
155	2x	graph_list <- add_expr(
156	2x	graph_list,
157	2x	quote(grid::grid.newpage())
158		)
159
160	2x	graph_list <- add_expr(
161	2x	graph_list,
162	2x	quote(grid::grid.draw(plot))
163		)
164
165	2x	y$graph <- bracket_expr(graph_list)
166
167	2x	y
168		}
169
170		#' teal Module: Individual Patient Plots
171		#'
172		#' This module produces [ggplot2::ggplot()] type individual patient plots that display trends in parameter
173		#' values over time for each patient, using data with ADaM structure.
174		#'
175		#' @inheritParams module_arguments
176		#' @inheritParams template_g_ipp
177		#' @param arm_var ([teal.transform::choices_selected()])\cr object with
178		#' all available choices and preselected option for variable values that can be used as arm variable.
179		#'
180		#' @inherit module_arguments return seealso
181		#'
182		#' @examples
183		#' library(nestcolor)
184		#' library(dplyr)
185		#'
186		#' ADSL <- tmc_ex_adsl %>%
187		#' slice(1:20) %>%
188		#' df_explicit_na()
189		#' ADLB <- tmc_ex_adlb %>%
190		#' filter(USUBJID %in% ADSL$USUBJID) %>%
191		#' df_explicit_na() %>%
192		#' filter(AVISIT != "SCREENING")
193		#'
194		#' app <- init(
195		#' data = cdisc_data(
196		#' ADSL = ADSL,
197		#' ADLB = ADLB,
198		#' code = "
199		#' ADSL <- tmc_ex_adsl %>% slice(1:20) %>% df_explicit_na()
200		#' ADLB <- tmc_ex_adlb %>% filter(USUBJID %in% ADSL$USUBJID) %>%
201		#' df_explicit_na() %>% filter(AVISIT != \"SCREENING\")
202		#' "
203		#' ),
204		#' modules = modules(
205		#' tm_g_ipp(
206		#' label = "Individual Patient Plot",
207		#' dataname = "ADLB",
208		#' arm_var = choices_selected(
209		#' value_choices(ADLB, "ARMCD"),
210		#' "ARM A"
211		#' ),
212		#' paramcd = choices_selected(
213		#' value_choices(ADLB, "PARAMCD"),
214		#' "ALT"
215		#' ),
216		#' aval_var = choices_selected(
217		#' variable_choices(ADLB, c("AVAL", "CHG")),
218		#' "AVAL"
219		#' ),
220		#' avalu_var = choices_selected(
221		#' variable_choices(ADLB, c("AVALU")),
222		#' "AVALU",
223		#' fixed = TRUE
224		#' ),
225		#' id_var = choices_selected(
226		#' variable_choices(ADLB, c("USUBJID")),
227		#' "USUBJID",
228		#' fixed = TRUE
229		#' ),
230		#' visit_var = choices_selected(
231		#' variable_choices(ADLB, c("AVISIT")),
232		#' "AVISIT"
233		#' ),
234		#' baseline_var = choices_selected(
235		#' variable_choices(ADLB, c("BASE")),
236		#' "BASE",
237		#' fixed = TRUE
238		#' ),
239		#' add_baseline_hline = FALSE,
240		#' separate_by_obs = FALSE
241		#' )
242		#' )
243		#' )
244		#' if (interactive()) {
245		#' shinyApp(app$ui, app$server)
246		#' }
247		#'
248		#' @export
249		tm_g_ipp <- function(label,
250		dataname,
251		parentname = ifelse(
252		inherits(arm_var, "data_extract_spec"),
253		teal.transform::datanames_input(arm_var),
254		"ADSL"
255		),
256		arm_var,
257		paramcd,
258		id_var = teal.transform::choices_selected(
259		teal.transform::variable_choices(dataname, "USUBJID"),
260		"USUBJID",
261		fixed = TRUE
262		),
263		visit_var = teal.transform::choices_selected(
264		teal.transform::variable_choices(dataname, "AVISIT"),
265		"AVISIT",
266		fixed = TRUE
267		),
268		aval_var = teal.transform::choices_selected(
269		teal.transform::variable_choices(dataname, "AVAL"),
270		"AVAL",
271		fixed = TRUE
272		),
273		avalu_var = teal.transform::choices_selected(
274		teal.transform::variable_choices(dataname, "AVALU"),
275		"AVALU",
276		fixed = TRUE
277		),
278		base_var = lifecycle::deprecated(),
279		baseline_var = teal.transform::choices_selected(
280		teal.transform::variable_choices(dataname, "BASE"),
281		"BASE",
282		fixed = TRUE
283		),
284		add_baseline_hline = FALSE,
285		separate_by_obs = FALSE,
286		suppress_legend = FALSE,
287		add_avalu = TRUE,
288		plot_height = c(1200L, 400L, 5000L),
289		plot_width = NULL,
290		pre_output = NULL,
291		post_output = NULL,
292		ggplot2_args = teal.widgets::ggplot2_args()) {
293	!	if (lifecycle::is_present(base_var)) {
294	!	baseline_var <- base_var
295	!	warning(
296	!	"The `base_var` argument of `tm_g_ipp()` is deprecated as of teal.modules.clinical 0.8.16. ",
297	!	"Please use the `baseline_var` argument instead.",
298	!	call. = FALSE
299		)
300		} else {
301	!	base_var <- baseline_var # resolves missing argument error
302		}
303
304	!	message("Initializing tm_g_ipp")
305	!	checkmate::assert_class(arm_var, "choices_selected")
306	!	checkmate::assert_class(paramcd, "choices_selected")
307	!	checkmate::assert_class(id_var, "choices_selected")
308	!	checkmate::assert_class(visit_var, "choices_selected")
309	!	checkmate::assert_class(aval_var, "choices_selected")
310	!	checkmate::assert_class(avalu_var, "choices_selected")
311	!	checkmate::assert_class(baseline_var, "choices_selected")
312	!	checkmate::assert_string(label)
313	!	checkmate::assert_string(dataname)
314	!	checkmate::assert_string(parentname)
315	!	checkmate::assert_flag(add_baseline_hline)
316	!	checkmate::assert_flag(separate_by_obs)
317	!	checkmate::assert_flag(suppress_legend)
318	!	checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
319	!	checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
320	!	checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
321	!	checkmate::assert_numeric(
322	!	plot_width[1],
323	!	lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
324		)
325	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
326	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
327	!	checkmate::assert_class(ggplot2_args, "ggplot2_args")
328
329	!	args <- as.list(environment())
330	!	data_extract_list <- list(
331	!	arm_var = cs_to_des_filter(arm_var, dataname = parentname, multiple = TRUE, include_vars = TRUE),
332	!	aval_var = cs_to_des_select(aval_var, dataname = dataname),
333	!	avalu_var = cs_to_des_select(avalu_var, dataname = dataname),
334	!	id_var = cs_to_des_select(id_var, dataname = dataname),
335	!	visit_var = cs_to_des_select(visit_var, dataname = dataname),
336	!	baseline_var = cs_to_des_select(baseline_var, dataname = dataname),
337	!	paramcd = cs_to_des_filter(paramcd, dataname = dataname)
338		)
339
340	!	module(
341	!	label = label,
342	!	server = srv_g_ipp,
343	!	ui = ui_g_ipp,
344	!	ui_args = c(data_extract_list, args),
345	!	server_args = c(
346	!	data_extract_list,
347	!	list(
348	!	dataname = dataname,
349	!	label = label,
350	!	parentname = parentname,
351	!	plot_height = plot_height,
352	!	plot_width = plot_width,
353	!	ggplot2_args = ggplot2_args
354		)
355		),
356	!	datanames = teal.transform::get_extract_datanames(data_extract_list)
357		)
358		}
359
360		#' @keywords internal
361		ui_g_ipp <- function(id, ...) {
362	!	a <- list(...) # module args
363	!	is_single_dataset_value <- teal.transform::is_single_dataset(
364	!	a$arm_var,
365	!	a$aval_var,
366	!	a$avalu_var,
367	!	a$id_var,
368	!	a$visit_var,
369	!	a$paramcd,
370	!	a$baseline_var
371		)
372
373	!	ns <- NS(id)
374
375	!	teal.widgets::standard_layout(
376	!	output = teal.widgets::plot_with_settings_ui(id = ns("myplot")),
377	!	encoding = tags$div(
378		### Reporter
379	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
380		###
381	!	tags$label("Encodings", class = "text-primary"),
382	!	teal.transform::datanames_input(
383	!	a[c("arm_var", "aval_var", "avalu_var", "id_var", "visit_var", "paramcd", "baseline_var")]
384		),
385	!	teal.transform::data_extract_ui(
386	!	id = ns("arm_var"),
387	!	label = "Select Arm",
388	!	data_extract_spec = a$arm_var,
389	!	is_single_dataset = is_single_dataset_value
390		),
391	!	teal.transform::data_extract_ui(
392	!	id = ns("paramcd"),
393	!	label = "Select Parameter",
394	!	data_extract_spec = a$paramcd,
395	!	is_single_dataset = is_single_dataset_value
396		),
397	!	teal.transform::data_extract_ui(
398	!	id = ns("visit_var"),
399	!	label = "Timepoint Variable",
400	!	data_extract_spec = a$visit_var,
401	!	is_single_dataset = is_single_dataset_value
402		),
403	!	teal.transform::data_extract_ui(
404	!	id = ns("aval_var"),
405	!	label = "Parameter values over Time",
406	!	data_extract_spec = a$aval_var,
407	!	is_single_dataset = is_single_dataset_value
408		),
409	!	teal.transform::data_extract_ui(
410	!	id = ns("id_var"),
411	!	label = "Patient ID",
412	!	data_extract_spec = a$id_var,
413	!	is_single_dataset = is_single_dataset_value
414		),
415	!	teal.transform::data_extract_ui(
416	!	id = ns("avalu_var"),
417	!	label = "Analysis Variable Unit",
418	!	data_extract_spec = a$avalu_var,
419	!	is_single_dataset = is_single_dataset_value
420		),
421	!	teal.transform::data_extract_ui(
422	!	id = ns("baseline_var"),
423	!	label = "Baseline Parameter Values",
424	!	data_extract_spec = a$baseline_var,
425	!	is_single_dataset = is_single_dataset_value
426		),
427	!	teal.widgets::panel_group(
428	!	teal.widgets::panel_item(
429	!	"Additional plot settings",
430	!	checkboxInput(
431	!	ns("add_baseline_hline"),
432	!	"Add reference lines at baseline value",
433	!	value = a$add_baseline_hline
434		),
435	!	checkboxInput(
436	!	ns("separate_by_obs"),
437	!	"Separate plots by ID",
438	!	value = a$separate_by_obs
439		),
440	!	checkboxInput(
441	!	ns("suppress_legend"),
442	!	"Suppress legend",
443	!	value = a$suppress_legend
444		),
445	!	checkboxInput(
446	!	ns("add_avalu"),
447	!	"Add unit value in title/y axis",
448	!	value = a$add_avalu
449		)
450		)
451		)
452		),
453	!	forms = tagList(
454	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
455		),
456	!	pre_output = a$pre_output,
457	!	post_output = a$post_output
458		)
459		}
460
461		#' @keywords internal
462		srv_g_ipp <- function(id,
463		data,
464		reporter,
465		filter_panel_api,
466		dataname,
467		parentname,
468		arm_var,
469		paramcd,
470		aval_var,
471		avalu_var,
472		id_var,
473		visit_var,
474		baseline_var,
475		plot_height,
476		plot_width,
477		label,
478		ggplot2_args) {
479	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
480	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
481	!	checkmate::assert_class(data, "reactive")
482	!	checkmate::assert_class(isolate(data()), "teal_data")
483
484	!	moduleServer(id, function(input, output, session) {
485	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
486	!	selector_list <- teal.transform::data_extract_multiple_srv(
487	!	datasets = data,
488	!	data_extract = list(
489	!	arm_var = arm_var,
490	!	aval_var = aval_var,
491	!	avalu_var = avalu_var,
492	!	id_var = id_var,
493	!	paramcd = paramcd,
494	!	visit_var = visit_var,
495	!	baseline_var = baseline_var
496		),
497	!	select_validation_rule = list(
498	!	aval_var = shinyvalidate::sv_required("A Parameter values over Time must be selected"),
499	!	avalu_var = shinyvalidate::sv_required("An Analysis Variable Unit must be selected"),
500	!	visit_var = shinyvalidate::sv_required("A Timepoint Variable must be selected"),
501	!	id_var = shinyvalidate::sv_required("A Patient ID must be selected"),
502	!	baseline_var = shinyvalidate::sv_required("Baseline Parameter Values must be selected")
503		),
504	!	filter_validation_rule = list(
505	!	paramcd = shinyvalidate::sv_required(message = "Please select Parameter filter."),
506	!	arm_var = shinyvalidate::sv_required(message = "Please select Arm filter.")
507		)
508		)
509
510	!	iv_r <- reactive({
511	!	iv <- shinyvalidate::InputValidator$new()
512	!	teal.transform::compose_and_enable_validators(iv, selector_list)
513		})
514
515	!	anl_inputs <- teal.transform::merge_expression_srv(
516	!	datasets = data,
517	!	selector_list = selector_list,
518	!	merge_function = "dplyr::inner_join"
519		)
520
521	!	adsl_inputs <- teal.transform::merge_expression_module(
522	!	datasets = data,
523	!	join_keys = teal.data::join_keys(data),
524	!	data_extract = list(arm_var = arm_var, id_var = id_var),
525	!	anl_name = "ANL_ADSL"
526		)
527
528	!	anl_q <- reactive({
529	!	data() %>%
530	!	teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
531	!	teal.code::eval_code(as.expression(adsl_inputs()$expr))
532		})
533
534		# Prepare the analysis environment (filter data, check data, populate envir).
535	!	validate_checks <- reactive({
536	!	teal::validate_inputs(iv_r())
537
538	!	adsl_filtered <- anl_q()[[parentname]]
539	!	anl_filtered <- anl_q()[[dataname]]
540
541	!	anl_m <- anl_inputs()
542	!	input_arm_var <- unlist(arm_var$filter)["vars_selected"]
543	!	input_aval_var <- as.vector(anl_m$columns_source$aval_var)
544	!	input_avalu_var <- as.vector(anl_m$columns_source$avalu_var)
545	!	input_id_var <- as.vector(anl_m$columns_source$id_var)
546	!	input_visit_var <- as.vector(anl_m$columns_source$visit_var)
547	!	input_baseline_var <- as.vector(anl_m$columns_source$baseline_var)
548	!	input_paramcd <- unlist(paramcd$filter)["vars_selected"]
549
550		# validate inputs
551	!	validate_args <- list(
552	!	adsl = adsl_filtered,
553	!	adslvars = c("STUDYID", input_id_var, input_arm_var),
554	!	anl = anl_filtered,
555	!	anlvars = c(
556	!	"STUDYID",
557	!	input_id_var,
558	!	input_arm_var,
559	!	input_aval_var,
560	!	input_avalu_var,
561	!	input_paramcd,
562	!	input_visit_var,
563	!	input_baseline_var
564		),
565	!	arm_var = input_arm_var
566		)
567
568	!	do.call(what = "validate_standard_inputs", validate_args)
569	!	NULL
570		})
571
572		# The R-code corresponding to the analysis.
573	!	all_q <- reactive({
574	!	validate_checks()
575	!	anl_m <- anl_inputs()
576
577	!	ANL <- anl_q()[["ANL"]]
578	!	teal::validate_has_data(ANL, 2)
579
580	!	arm_var <- unlist(arm_var$filter)["vars_selected"]
581	!	avalu_var <- as.vector(anl_m$columns_source$avalu_var)
582	!	paramcd <- unlist(paramcd$filter)["vars_selected"]
583
584	!	avalu_first <- as.character(ANL[[avalu_var]][1])
585	!	paramcd_first <- as.character(ANL[[paramcd]][1])
586	!	arm_levels <- levels(droplevels(ANL[[arm_var]]))
587
588	!	my_calls <- template_g_ipp(
589	!	dataname = "ANL",
590	!	aval_var = as.vector(anl_m$columns_source$aval_var),
591	!	avalu_var = avalu_var,
592	!	avalu_first = avalu_first,
593	!	id_var = as.vector(anl_m$columns_source$id_var),
594	!	visit_var = as.vector(anl_m$columns_source$visit_var),
595	!	baseline_var = as.vector(anl_m$columns_source$baseline_var),
596	!	add_baseline_hline = input$add_baseline_hline,
597	!	separate_by_obs = input$separate_by_obs,
598	!	suppress_legend = input$suppress_legend,
599	!	paramcd = paramcd,
600	!	paramcd_first = paramcd_first,
601	!	arm_var = arm_var,
602	!	arm_levels = arm_levels,
603	!	ggplot2_args = ggplot2_args,
604	!	add_avalu = input$add_avalu
605		)
606	!	teal.code::eval_code(anl_q(), as.expression(my_calls))
607		})
608
609		# Outputs to render.
610	!	plot_r <- reactive(all_q()[["plot"]])
611
612		# Insert the plot into a plot with settings module from teal.widgets
613	!	pws <- teal.widgets::plot_with_settings_srv(
614	!	id = "myplot",
615	!	plot_r = plot_r,
616	!	height = plot_height,
617	!	width = plot_width
618		)
619
620	!	teal.widgets::verbatim_popup_srv(
621	!	id = "rcode",
622	!	verbatim_content = reactive(teal.code::get_code(all_q())),
623	!	title = label
624		)
625
626		### REPORTER
627	!	if (with_reporter) {
628	!	card_fun <- function(comment, label) {
629	!	card <- teal::report_card_template(
630	!	title = "Individual Patient Plot",
631	!	label = label,
632	!	with_filter = with_filter,
633	!	filter_panel_api = filter_panel_api
634		)
635	!	card$append_text("Plot", "header3")
636	!	card$append_plot(plot_r(), dim = pws$dim())
637	!	if (!comment == "") {
638	!	card$append_text("Comment", "header3")
639	!	card$append_text(comment)
640		}
641	!	card$append_src(teal.code::get_code(all_q()))
642	!	card
643		}
644	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
645		}
646		###
647		})
648		}

1		#' Template: Confidence Interval Plot
2		#'
3		#' Creates a valid expression to generate a [ggplot2::ggplot()] confidence interval plot.
4		#'
5		#' @inheritParams template_arguments
6		#' @param x_var (`character`)\cr name of the treatment variable to put on the x-axis.
7		#' @param y_var (`character`)\cr name of the response variable to put on the y-axis.
8		#' @param grp_var (`character`)\cr name of the group variable used to determine the plot colors, point shapes,
9		#' and line types.
10		#' @param stat (`character`)\cr statistic to plot. Options are `"mean"` and `"median"`.
11		#' @param unit_var (`character`)\cr name of the unit variable.
12		#'
13		#' @inherit template_arguments return
14		#'
15		#' @seealso [tm_g_ci()]
16		#'
17		#' @keywords internal
18		template_g_ci <- function(dataname,
19		x_var,
20		y_var,
21		grp_var = NULL,
22		stat = c("mean", "median"),
23		conf_level = 0.95,
24		unit_var = "AVALU",
25		ggplot2_args = teal.widgets::ggplot2_args()) {
26	4x	stat <- match.arg(stat)
27
28	4x	graph_list <- list()
29	4x	graph_list <- if (is.null(grp_var)) {
30	!	add_expr(
31	!	expr_ls = graph_list,
32	!	new_expr = {
33	!	substitute(
34	!	expr = ggplot2::ggplot(
35	!	data = ANL,
36	!	mapping = ggplot2::aes(
37	!	x = x_var,
38	!	y = y_var
39		)
40		),
41	!	env = list(
42	!	x_var = as.name(x_var),
43	!	y_var = as.name(y_var)
44		)
45		)
46		}
47		)
48		} else {
49	4x	add_expr(
50	4x	expr_ls = graph_list,
51	4x	new_expr = {
52	4x	substitute(
53	4x	expr = ggplot2::ggplot(
54	4x	data = ANL,
55	4x	mapping = ggplot2::aes(
56	4x	x = x_var,
57	4x	y = y_var,
58	4x	color = grp_var,
59	4x	lty = grp_var,
60	4x	shape = grp_var
61		)
62		),
63	4x	env = list(
64	4x	x_var = as.name(x_var),
65	4x	y_var = as.name(y_var),
66	4x	grp_var = as.name(grp_var)
67		)
68		)
69		}
70		)
71		}
72
73	4x	graph_list <- if (conf_level == 0.95) {
74	3x	add_expr(
75	3x	expr_ls = graph_list,
76	3x	new_expr = substitute(
77	3x	expr = ggplot2::stat_summary(
78	3x	fun.data = fun,
79	3x	geom = "errorbar",
80	3x	width = .1,
81	3x	position = ggplot2::position_dodge(width = .5)
82		),
83	3x	env = list(
84	3x	fun = switch(stat,
85	3x	mean = substitute(stat_mean_ci),
86	3x	median = substitute(stat_median_ci)
87		)
88		)
89		)
90		)
91		} else {
92	1x	add_expr(
93	1x	expr_ls = graph_list,
94	1x	new_expr = substitute(
95	1x	expr = ggplot2::stat_summary(
96	1x	fun.data = fun,
97	1x	geom = "errorbar",
98	1x	width = .1,
99	1x	position = ggplot2::position_dodge(width = .5)
100		),
101	1x	env = list(
102	1x	fun = switch(stat,
103	1x	mean = substitute(
104	1x	expr = function(x) stat_mean_ci(x, conf_level = conf_level),
105	1x	env = list(conf_level = conf_level)
106		),
107	1x	median = substitute(
108	1x	expr = function(x) stat_median_ci(x, conf_level = conf_level),
109	1x	env = list(conf_level = conf_level)
110		)
111		)
112		)
113		)
114		)
115		}
116
117	4x	graph_list <- add_expr(
118	4x	expr_ls = graph_list,
119	4x	new_expr = substitute(
120	4x	expr = ggplot2::stat_summary(
121	4x	fun = fun,
122	4x	geom = "point",
123	4x	position = ggplot2::position_dodge(width = .5)
124		),
125	4x	env = list(
126	4x	fun = switch(stat,
127	4x	mean = quote(mean),
128	4x	median = quote(median)
129		)
130		)
131		)
132		)
133
134	4x	parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args(
135	4x	teal.widgets::resolve_ggplot2_args(
136	4x	user_plot = ggplot2_args,
137	4x	module_plot = teal.widgets::ggplot2_args(
138	4x	labs = list(
139	4x	title = "Confidence Interval Plot by Treatment Group",
140	4x	caption = sprintf(
141	4x	"%s and %i%% CIs for %s are displayed.",
142	4x	switch(stat,
143	4x	mean = "Mean",
144	4x	median = "Median"
145		),
146	4x	100 * conf_level,
147	4x	stat
148		),
149	4x	x = "Treatment Group",
150	4x	y = "Value",
151	4x	color = "",
152	4x	lty = "",
153	4x	shape = ""
154		),
155	4x	theme = list()
156		)
157		)
158		)
159
160	4x	graph_list <- add_expr(
161	4x	expr_ls = graph_list,
162	4x	new_expr = parsed_ggplot2_args$labs
163		)
164
165	4x	if (!is.null(parsed_ggplot2_args$theme)) {
166	!	graph_list <- add_expr(
167	!	expr_ls = graph_list,
168	!	new_expr = parsed_ggplot2_args$theme
169		)
170		}
171
172	4x	substitute(
173	4x	expr = {
174	!	gg <- graph_expr
175	!	print(gg)
176		},
177	4x	env = list(graph_expr = pipe_expr(graph_list, pipe_str = "+"))
178		)
179		}
180
181		#' teal Module: Confidence Interval Plot
182		#'
183		#' This module produces a [ggplot2::ggplot()] type confidence interval plot consistent with the TLG Catalog template
184		#' `CIG01` available [here](https://insightsengineering.github.io/tlg-catalog/stable/graphs/other/cig01.html).
185		#'
186		#' @inheritParams module_arguments
187		#' @inheritParams template_g_ci
188		#' @param color (`data_extract_spec`)\cr the group variable used to determine the plot colors, shapes, and line types.
189		#'
190		#' @inherit module_arguments return seealso
191		#'
192		#' @examples
193		#' library(nestcolor)
194		#'
195		#' ADSL <- tmc_ex_adsl
196		#' ADLB <- tmc_ex_adlb
197		#'
198		#' app <- init(
199		#' data = cdisc_data(
200		#' ADSL = ADSL,
201		#' ADLB = ADLB,
202		#' code = "
203		#' ADSL <- tmc_ex_adsl
204		#' ADLB <- tmc_ex_adlb
205		#' "
206		#' ),
207		#' modules = modules(
208		#' tm_g_ci(
209		#' label = "Confidence Interval Plot",
210		#' x_var = data_extract_spec(
211		#' dataname = "ADSL",
212		#' select = select_spec(
213		#' choices = c("ARMCD", "BMRKR2"),
214		#' selected = c("ARMCD"),
215		#' multiple = FALSE,
216		#' fixed = FALSE
217		#' )
218		#' ),
219		#' y_var = data_extract_spec(
220		#' dataname = "ADLB",
221		#' filter = list(
222		#' filter_spec(
223		#' vars = "PARAMCD",
224		#' choices = levels(ADLB$PARAMCD),
225		#' selected = levels(ADLB$PARAMCD)[1],
226		#' multiple = FALSE,
227		#' label = "Select lab:"
228		#' ),
229		#' filter_spec(
230		#' vars = "AVISIT",
231		#' choices = levels(ADLB$AVISIT),
232		#' selected = levels(ADLB$AVISIT)[1],
233		#' multiple = FALSE,
234		#' label = "Select visit:"
235		#' )
236		#' ),
237		#' select = select_spec(
238		#' label = "Analyzed Value",
239		#' choices = c("AVAL", "CHG"),
240		#' selected = "AVAL",
241		#' multiple = FALSE,
242		#' fixed = FALSE
243		#' )
244		#' ),
245		#' color = data_extract_spec(
246		#' dataname = "ADSL",
247		#' select = select_spec(
248		#' label = "Color by variable",
249		#' choices = c("SEX", "STRATA1", "STRATA2"),
250		#' selected = c("STRATA1"),
251		#' multiple = FALSE,
252		#' fixed = FALSE
253		#' )
254		#' )
255		#' )
256		#' ),
257		#' header = "Example of Confidence Interval Plot",
258		#' footer = tags$p(
259		#' class = "text-muted", "Source: `teal.modules.clinical::tm_g_ci`"
260		#' )
261		#' )
262		#' if (interactive()) {
263		#' shinyApp(app$ui, app$server)
264		#' }
265		#'
266		#' @export
267		tm_g_ci <- function(label,
268		x_var,
269		y_var,
270		color,
271		stat = c("mean", "median"),
272		conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE),
273		plot_height = c(700L, 200L, 2000L),
274		plot_width = NULL,
275		pre_output = NULL,
276		post_output = NULL,
277		ggplot2_args = teal.widgets::ggplot2_args()) {
278	!	message("Initializing tm_g_ci")
279	!	checkmate::assert_string(label)
280	!	stat <- match.arg(stat)
281	!	checkmate::assert_class(y_var, classes = "data_extract_spec")
282	!	checkmate::assert_class(x_var, classes = "data_extract_spec")
283	!	checkmate::assert_class(color, classes = "data_extract_spec")
284	!	checkmate::assert_class(conf_level, "choices_selected")
285	!	checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
286	!	checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
287	!	checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
288	!	checkmate::assert_numeric(
289	!	plot_width[1],
290	!	lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
291		)
292	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
293	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
294	!	checkmate::assert_class(ggplot2_args, "ggplot2_args")
295
296	!	args <- as.list(environment())
297
298	!	module(
299	!	label = label,
300	!	server = srv_g_ci,
301	!	server_args = list(
302	!	x_var = x_var,
303	!	y_var = y_var,
304	!	color = color,
305	!	label = label,
306	!	plot_height = plot_height,
307	!	plot_width = plot_width,
308	!	ggplot2_args = ggplot2_args
309		),
310	!	ui = ui_g_ci,
311	!	ui_args = args,
312	!	datanames = "all"
313		)
314		}
315
316		#' @keywords internal
317		ui_g_ci <- function(id, ...) {
318	!	ns <- NS(id)
319	!	args <- list(...)
320
321	!	teal.widgets::standard_layout(
322	!	output = teal.widgets::plot_with_settings_ui(id = ns("myplot")),
323	!	encoding = tags$div(
324		### Reporter
325	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
326		###
327	!	tags$label("Encodings", class = "text-primary"),
328	!	teal.transform::datanames_input(args[c("x_var", "y_var", "color")]),
329	!	teal.transform::data_extract_ui(
330	!	id = ns("x_var"),
331	!	label = "Treatment (x axis)",
332	!	data_extract_spec = args$x_var
333		),
334	!	teal.transform::data_extract_ui(
335	!	id = ns("y_var"),
336	!	label = "Analysis Value (y axis)",
337	!	data_extract_spec = args$y_var
338		),
339	!	teal.transform::data_extract_ui(
340	!	id = ns("color"),
341	!	label = "Groups (color)",
342	!	data_extract_spec = args$color
343		),
344	!	teal.widgets::optionalSelectInput(
345	!	inputId = ns("conf_level"),
346	!	label = "Confidence Level",
347	!	choices = args$conf_level$choices,
348	!	selected = args$conf_level$selected,
349	!	multiple = FALSE,
350	!	fixed = args$conf_level$fixed
351		),
352	!	radioButtons(
353	!	inputId = ns("stat"),
354	!	label = "Statistic to use",
355	!	choices = c("mean", "median"),
356	!	selected = args$stat
357		)
358		),
359	!	forms = tagList(
360	!	teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
361		),
362	!	pre_output = args$pre_output,
363	!	post_output = args$post_output
364		)
365		}
366
367		#' @keywords internal
368		srv_g_ci <- function(id,
369		data,
370		reporter,
371		filter_panel_api,
372		x_var,
373		y_var,
374		color,
375		label,
376		plot_height,
377		plot_width,
378		ggplot2_args) {
379	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
380	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
381	!	checkmate::assert_class(data, "reactive")
382	!	checkmate::assert_class(isolate(data()), "teal_data")
383
384	!	moduleServer(id, function(input, output, session) {
385	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
386	!	selector_list <- teal.transform::data_extract_multiple_srv(
387	!	data_extract = list(x_var = x_var, y_var = y_var, color = color),
388	!	datasets = data,
389	!	select_validation_rule = list(
390	!	x_var = shinyvalidate::sv_required("Select a treatment (x axis)"),
391	!	y_var = shinyvalidate::sv_required("Select an analysis value (y axis)")
392		),
393	!	filter_validation_rule = list(
394	!	y_var = shinyvalidate::sv_required(message = "Please select the filters.")
395		)
396		)
397
398	!	iv_r <- reactive({
399	!	iv <- shinyvalidate::InputValidator$new()
400	!	iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level"))
401	!	iv$add_rule(
402	!	"conf_level",
403	!	shinyvalidate::sv_between(0, 1, message_fmt = "Please choose a confidence level between 0 and 1")
404		)
405	!	teal.transform::compose_and_enable_validators(iv, selector_list)
406		})
407
408	!	anl_inputs <- teal.transform::merge_expression_srv(
409	!	datasets = data,
410	!	join_keys = teal.data::join_keys(data),
411	!	selector_list = selector_list
412		)
413
414	!	anl_q <- reactive({
415	!	data() %>%
416	!	teal.code::eval_code(as.expression(anl_inputs()$expr))
417		})
418
419	!	all_q <- reactive({
420	!	teal::validate_inputs(iv_r())
421	!	teal::validate_has_data(anl_q()[["ANL"]], min_nrow = 2)
422
423	!	x <- anl_inputs()$columns_source$x_var
424	!	y <- anl_inputs()$columns_source$y_var
425	!	color <- anl_inputs()$columns_source$color
426
427	!	validate(
428	!	need(
429	!	!all(is.na(anl_q()[["ANL"]][[y]])),
430	!	"No valid data. Please check the filtering option for analysis value (y axis)"
431		)
432		)
433
434	!	x_label <- column_annotation_label(data()[[attr(x, "dataname")]], x)
435	!	y_label <- column_annotation_label(data()[[attr(y, "dataname")]], y)
436	!	color_label <- if (length(color)) {
437	!	column_annotation_label(data()[[attr(color, "dataname")]], color)
438		} else {
439	!	NULL
440		}
441
442	!	ggplot2_args$labs$title <- paste("Confidence Interval Plot by", x_label)
443	!	ggplot2_args$labs$x <- x_label
444	!	ggplot2_args$labs$subtitle <- paste("Visit:", anl_inputs()$filter_info$y_var[[2]]$selected[[1]])
445	!	ggplot2_args$labs$y <- paste(
446	!	anl_inputs()$filter_info$y_var[[1]]$selected[[1]],
447	!	y_label
448		)
449	!	ggplot2_args$labs$color <- color_label
450	!	ggplot2_args$labs$lty <- color_label
451	!	ggplot2_args$labs$shape <- color_label
452	!	list_calls <- template_g_ci(
453	!	dataname = "ANL",
454	!	x_var = x,
455	!	y_var = y,
456	!	grp_var = if (length(color) == 0) {
457	!	NULL
458		} else {
459	!	color
460		},
461	!	stat = input$stat,
462	!	conf_level = as.numeric(input$conf_level),
463	!	ggplot2_args = ggplot2_args
464		)
465	!	teal.code::eval_code(anl_q(), list_calls)
466		})
467
468	!	plot_r <- reactive(all_q()[["gg"]])
469
470	!	teal.widgets::verbatim_popup_srv(
471	!	id = "rcode",
472	!	verbatim_content = reactive(teal.code::get_code(all_q())),
473	!	title = label
474		)
475
476	!	pws <- teal.widgets::plot_with_settings_srv(
477	!	id = "myplot",
478	!	plot_r = plot_r,
479	!	height = plot_height,
480	!	width = plot_width
481		)
482
483		### REPORTER
484	!	if (with_reporter) {
485	!	card_fun <- function(comment, label) {
486	!	card <- teal::report_card_template(
487	!	title = "CI Plot",
488	!	label = label,
489	!	description = "Confidence Interval Plot",
490	!	with_filter = with_filter,
491	!	filter_panel_api = filter_panel_api
492		)
493	!	card$append_text("Plot", "header3")
494	!	card$append_plot(plot_r(), dim = pws$dim())
495	!	if (!comment == "") {
496	!	card$append_text("Comment", "header3")
497	!	card$append_text(comment)
498		}
499	!	card$append_src(teal.code::get_code(all_q()))
500	!	card
501		}
502	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
503		}
504		###
505		})
506		}

1		#' Template: Shift by Arm
2		#'
3		#' Creates a valid expression to generate a summary table of analysis indicator levels by arm.
4		#'
5		#' @inheritParams template_arguments
6		#' @param aval_var (`character`)\cr name of the analysis reference range indicator variable.
7		#' @param baseline_var (`character`)\cr name of the baseline reference range indicator variable.
8		#' @param add_total (`logical`)\cr whether to include row with total number of patients.
9		#'
10		#' @inherit template_arguments return
11		#'
12		#' @seealso [tm_t_shift_by_arm()]
13		#'
14		#' @keywords internal
15		template_shift_by_arm <- function(dataname,
16		parentname,
17		arm_var = "ARM",
18		paramcd = "PARAMCD",
19		visit_var = "AVISIT",
20		treatment_flag_var = "ONTRTFL",
21		treatment_flag = "Y",
22		aval_var = "ANRIND",
23		base_var = lifecycle::deprecated(),
24		baseline_var = "BNRIND",
25		na.rm = FALSE, # nolint: object_name.
26		na_level = default_na_str(),
27		add_total = FALSE,
28		total_label = default_total_label(),
29		basic_table_args = teal.widgets::basic_table_args()) {
30	3x	if (lifecycle::is_present(base_var)) {
31	!	baseline_var <- base_var
32	!	warning(
33	!	"The `base_var` argument of `template_shift_by_arm()` is deprecated as of teal.modules.clinical 0.8.16. ",
34	!	"Please use the `baseline_var` argument instead.",
35	!	call. = FALSE
36		)
37		}
38
39	3x	checkmate::assert_string(dataname)
40	3x	checkmate::assert_string(parentname)
41	3x	checkmate::assert_string(arm_var)
42	3x	checkmate::assert_string(visit_var)
43	3x	checkmate::assert_string(paramcd, na.ok = TRUE)
44	3x	checkmate::assert_string(aval_var)
45	3x	checkmate::assert_string(baseline_var)
46	3x	checkmate::assert_flag(na.rm)
47	3x	checkmate::assert_string(na_level)
48	3x	checkmate::assert_string(treatment_flag_var)
49	3x	checkmate::assert_string(treatment_flag)
50	3x	checkmate::assert_flag(add_total)
51	3x	checkmate::assert_string(total_label)
52
53	3x	y <- list()
54
55		# Start data steps.
56	3x	data_list <- list()
57	3x	data_list <- add_expr(
58	3x	data_list,
59	3x	substitute(
60	3x	expr = parentname <- df_explicit_na(parentname, na_level = na_str),
61	3x	env = list(parentname = as.name(parentname), na_str = na_level)
62		)
63		)
64	3x	data_list <- add_expr(
65	3x	data_list,
66	3x	substitute(
67	3x	expr = dataname <- df_explicit_na(dataname, na_level = na_str) %>%
68	3x	dplyr::filter(treatment_flag_var == treatment_flag),
69	3x	env = list(
70	3x	dataname = as.name(dataname),
71	3x	na_str = na_level,
72	3x	treatment_flag_var = as.name(treatment_flag_var),
73	3x	treatment_flag = treatment_flag
74		)
75		)
76		)
77
78	3x	data_list <- add_expr(
79	3x	data_list,
80	3x	substitute(
81	3x	expr = attr(dataname$baseline_var, "label") <- "Baseline Assessment",
82	3x	env = list(dataname = as.name(dataname), baseline_var = baseline_var)
83		)
84		)
85
86	3x	y$data <- bracket_expr(data_list)
87
88	3x	parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
89	3x	teal.widgets::resolve_basic_table_args(
90	3x	user_table = basic_table_args
91		)
92		)
93
94		# Start layout steps.
95	3x	layout_list <- list()
96
97	3x	if (add_total) {
98	1x	layout_list <- add_expr(
99	1x	layout_list,
100	1x	substitute(
101	1x	expr = expr_basic_table_args %>%
102	1x	rtables::split_cols_by(visit_var, split_fun = drop_split_levels) %>% # temp solution for over arching column
103	1x	rtables::split_cols_by(aval_var) %>%
104	1x	rtables::split_rows_by(
105	1x	arm_var,
106	1x	split_fun = add_overall_level(total_label, first = FALSE),
107	1x	label_pos = "topleft",
108	1x	split_label = obj_label(dataname$arm_var)
109		) %>%
110	1x	add_rowcounts() %>%
111	1x	analyze_vars(
112	1x	baseline_var,
113	1x	denom = "N_row",
114	1x	na_str = na_str,
115	1x	na.rm = na.rm,
116	1x	.stats = "count_fraction"
117		) %>%
118	1x	append_varlabels(dataname, baseline_var, indent = 1L),
119	1x	env = list(
120	1x	aval_var = aval_var,
121	1x	arm_var = arm_var,
122	1x	baseline_var = baseline_var,
123	1x	dataname = as.name(dataname),
124	1x	visit_var = visit_var,
125	1x	na.rm = na.rm,
126	1x	na_str = na_level,
127	1x	total_label = total_label,
128	1x	expr_basic_table_args = parsed_basic_table_args
129		)
130		)
131		)
132		} else {
133	2x	layout_list <- add_expr(
134	2x	layout_list,
135	2x	substitute(
136	2x	expr = expr_basic_table_args %>%
137	2x	rtables::split_cols_by(visit_var, split_fun = drop_split_levels) %>% # temp solution for over arching column
138	2x	rtables::split_cols_by(aval_var) %>%
139	2x	rtables::split_rows_by(
140	2x	arm_var,
141	2x	split_fun = drop_split_levels,
142	2x	label_pos = "topleft",
143	2x	split_label = obj_label(dataname$arm_var)
144		) %>%
145	2x	add_rowcounts() %>%
146	2x	analyze_vars(
147	2x	baseline_var,
148	2x	denom = "N_row",
149	2x	na_str = na_str,
150	2x	na.rm = na.rm,
151	2x	.stats = "count_fraction"
152		) %>%
153	2x	append_varlabels(dataname, baseline_var, indent = 1L),
154	2x	env = list(
155	2x	aval_var = aval_var,
156	2x	arm_var = arm_var,
157	2x	baseline_var = baseline_var,
158	2x	dataname = as.name(dataname),
159	2x	visit_var = visit_var,
160	2x	na.rm = na.rm,
161	2x	na_str = na_level,
162	2x	expr_basic_table_args = parsed_basic_table_args
163		)
164		)
165		)
166		}
167
168	3x	y$layout <- substitute(
169	3x	expr = lyt <- layout_pipe,
170	3x	env = list(layout_pipe = pipe_expr(layout_list))
171		)
172
173		# Full table.
174	3x	y$table <- substitute(
175	3x	expr = {
176	!	result <- rtables::build_table(lyt = lyt, df = dataname)
177	!	result
178		},
179	3x	env = list(dataname = as.name(dataname))
180		)
181
182	3x	y
183		}
184
185		#' teal Module: Shift by Arm
186		#'
187		#' This module produces a summary table of analysis indicator levels by arm.
188		#'
189		#' @inheritParams module_arguments
190		#' @inheritParams template_shift_by_arm
191		#'
192		#' @inherit module_arguments return seealso
193		#'
194		#' @examples
195		#' ADSL <- tmc_ex_adsl
196		#' ADEG <- tmc_ex_adeg
197		#'
198		#' app <- init(
199		#' data = cdisc_data(
200		#' ADSL = ADSL,
201		#' ADEG = ADEG,
202		#' code = "
203		#' ADSL <- tmc_ex_adsl
204		#' ADEG <- tmc_ex_adeg
205		#' "
206		#' ),
207		#' modules = modules(
208		#' tm_t_shift_by_arm(
209		#' label = "Shift by Arm Table",
210		#' dataname = "ADEG",
211		#' arm_var = choices_selected(
212		#' variable_choices(ADSL, subset = c("ARM", "ARMCD")),
213		#' selected = "ARM"
214		#' ),
215		#' paramcd = choices_selected(
216		#' value_choices(ADEG, "PARAMCD"),
217		#' selected = "HR"
218		#' ),
219		#' visit_var = choices_selected(
220		#' value_choices(ADEG, "AVISIT"),
221		#' selected = "POST-BASELINE MINIMUM"
222		#' ),
223		#' aval_var = choices_selected(
224		#' variable_choices(ADEG, subset = "ANRIND"),
225		#' selected = "ANRIND", fixed = TRUE
226		#' ),
227		#' baseline_var = choices_selected(
228		#' variable_choices(ADEG, subset = "BNRIND"),
229		#' selected = "BNRIND", fixed = TRUE
230		#' ),
231		#' useNA = "ifany"
232		#' )
233		#' )
234		#' )
235		#' if (interactive()) {
236		#' shinyApp(app$ui, app$server)
237		#' }
238		#'
239		#' @export
240		tm_t_shift_by_arm <- function(label,
241		dataname,
242		parentname = ifelse(
243		inherits(arm_var, "data_extract_spec"),
244		teal.transform::datanames_input(arm_var),
245		"ADSL"
246		),
247		arm_var,
248		paramcd,
249		visit_var,
250		aval_var,
251		base_var = lifecycle::deprecated(),
252		baseline_var,
253		treatment_flag_var = teal.transform::choices_selected(
254		teal.transform::variable_choices(dataname, subset = "ONTRTFL"),
255		selected = "ONTRTFL"
256		),
257		treatment_flag = teal.transform::choices_selected("Y"),
258		useNA = c("ifany", "no"), # nolint: object_name.
259		na_level = default_na_str(),
260		add_total = FALSE,
261		total_label = default_total_label(),
262		pre_output = NULL,
263		post_output = NULL,
264		basic_table_args = teal.widgets::basic_table_args()) {
265	!	if (lifecycle::is_present(base_var)) {
266	!	baseline_var <- base_var
267	!	warning(
268	!	"The `base_var` argument of `tm_t_shift_by_arm()` is deprecated as of teal.modules.clinical 0.8.16. ",
269	!	"Please use the `baseline_var` argument instead.",
270	!	call. = FALSE
271		)
272		} else {
273	!	base_var <- baseline_var # resolves missing argument error
274		}
275
276	!	message("Initializing tm_t_shift_by_arm")
277	!	checkmate::assert_string(label)
278	!	checkmate::assert_string(dataname)
279	!	checkmate::assert_string(parentname)
280	!	useNA <- match.arg(useNA) # nolint: object_name.
281	!	checkmate::assert_string(na_level)
282	!	checkmate::assert_string(total_label)
283	!	checkmate::assert_class(arm_var, "choices_selected")
284	!	checkmate::assert_class(paramcd, "choices_selected")
285	!	checkmate::assert_class(visit_var, "choices_selected")
286	!	checkmate::assert_class(aval_var, "choices_selected")
287	!	checkmate::assert_class(baseline_var, "choices_selected")
288	!	checkmate::assert_class(treatment_flag_var, "choices_selected")
289	!	checkmate::assert_class(treatment_flag, "choices_selected")
290	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
291	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
292	!	checkmate::assert_class(basic_table_args, "basic_table_args")
293
294	!	args <- as.list(environment())
295
296	!	data_extract_list <- list(
297	!	arm_var = cs_to_des_select(arm_var, dataname = parentname),
298	!	paramcd = cs_to_des_filter(paramcd, dataname = dataname),
299	!	visit_var = cs_to_des_filter(visit_var, dataname = dataname),
300	!	treatment_flag_var = cs_to_des_select(treatment_flag_var, dataname = dataname),
301	!	aval_var = cs_to_des_select(aval_var, dataname = dataname),
302	!	baseline_var = cs_to_des_select(baseline_var, dataname = dataname)
303		)
304
305	!	module(
306	!	label = label,
307	!	server = srv_shift_by_arm,
308	!	ui = ui_shift_by_arm,
309	!	ui_args = c(data_extract_list, args),
310	!	server_args = c(
311	!	data_extract_list,
312	!	list(
313	!	dataname = dataname,
314	!	parentname = parentname,
315	!	label = label,
316	!	total_label = total_label,
317	!	na_level = na_level,
318	!	treatment_flag = treatment_flag,
319	!	basic_table_args = basic_table_args
320		)
321		),
322	!	datanames = teal.transform::get_extract_datanames(data_extract_list)
323		)
324		}
325
326		#' @keywords internal
327		ui_shift_by_arm <- function(id, ...) {
328	!	ns <- NS(id)
329	!	a <- list(...)
330
331	!	is_single_dataset_value <- teal.transform::is_single_dataset(
332	!	a$id_var,
333	!	a$arm_var,
334	!	a$paramcd,
335	!	a$visit_var,
336	!	a$treatment_flag_var,
337	!	a$treatment_flag,
338	!	a$aval_var,
339	!	a$baseline_var
340		)
341
342	!	teal.widgets::standard_layout(
343	!	output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("table"))),
344	!	encoding = tags$div(
345		### Reporter
346	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
347		###
348	!	tags$label("Encodings", class = "text-primary"),
349	!	teal.transform::datanames_input(a[c(
350	!	"arm_var", "paramcd_var", "paramcd", "aval_var", "baseline_var", "visit_var", "treamtment_flag_var"
351		)]),
352	!	teal.transform::data_extract_ui(
353	!	id = ns("arm_var"),
354	!	label = "Select Treatment Variable",
355	!	data_extract_spec = a$arm_var,
356	!	is_single_dataset = is_single_dataset_value
357		),
358	!	teal.transform::data_extract_ui(
359	!	id = ns("paramcd"),
360	!	label = "Select Endpoint",
361	!	data_extract_spec = a$paramcd,
362	!	is_single_dataset = is_single_dataset_value
363		),
364	!	teal.transform::data_extract_ui(
365	!	id = ns("visit_var"),
366	!	label = "Select Visit",
367	!	data_extract_spec = a$visit_var,
368	!	is_single_dataset = is_single_dataset_value
369		),
370	!	teal.transform::data_extract_ui(
371	!	id = ns("aval_var"),
372	!	label = "Select Analysis Range Indicator Variable",
373	!	data_extract_spec = a$aval_var,
374	!	is_single_dataset = is_single_dataset_value
375		),
376	!	teal.transform::data_extract_ui(
377	!	id = ns("baseline_var"),
378	!	label = "Select Baseline Reference Range Indicator Variable",
379	!	data_extract_spec = a$baseline_var,
380	!	is_single_dataset = is_single_dataset_value
381		),
382	!	checkboxInput(ns("add_total"), "Add All Patients row", value = a$add_total),
383	!	radioButtons(
384	!	ns("useNA"),
385	!	label = "Display NA counts",
386	!	choices = c("ifany", "no"),
387	!	selected = a$useNA
388		),
389	!	teal.widgets::panel_group(
390	!	teal.widgets::panel_item(
391	!	"Additional Variables Info",
392	!	teal.transform::data_extract_ui(
393	!	id = ns("treatment_flag_var"),
394	!	label = "On Treatment Flag Variable",
395	!	data_extract_spec = a$treatment_flag_var,
396	!	is_single_dataset = is_single_dataset_value
397		),
398	!	teal.widgets::optionalSelectInput(
399	!	ns("treatment_flag"),
400	!	label = "Value Indicating On Treatment",
401	!	multiple = FALSE,
402	!	fixed_on_single = TRUE
403		)
404		)
405		)
406		),
407	!	forms = tagList(
408	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
409		),
410	!	pre_output = a$pre_output,
411	!	post_output = a$post_output
412		)
413		}
414
415		#' @keywords internal
416		srv_shift_by_arm <- function(id,
417		data,
418		reporter,
419		filter_panel_api,
420		dataname,
421		parentname,
422		arm_var,
423		paramcd,
424		visit_var,
425		treatment_flag_var,
426		treatment_flag,
427		aval_var,
428		baseline_var,
429		label,
430		na_level,
431		add_total,
432		total_label,
433		basic_table_args) {
434	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
435	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
436	!	checkmate::assert_class(data, "reactive")
437	!	checkmate::assert_class(shiny::isolate(data()), "teal_data")
438	!	moduleServer(id, function(input, output, session) {
439	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
440	!	selector_list <- teal.transform::data_extract_multiple_srv(
441	!	data_extract = list(
442	!	arm_var = arm_var,
443	!	paramcd = paramcd,
444	!	visit_var = visit_var,
445	!	aval_var = aval_var,
446	!	baseline_var = baseline_var,
447	!	treatment_flag_var = treatment_flag_var
448		),
449	!	datasets = data,
450	!	select_validation_rule = list(
451	!	aval_var = shinyvalidate::sv_required("An analysis range indicator required"),
452	!	arm_var = shinyvalidate::sv_required("A treatment variable is required"),
453	!	treatment_flag_var = shinyvalidate::sv_required("An on treatment flag variable is required"),
454	!	baseline_var = shinyvalidate::sv_required("A baseline reference range indicator is required")
455		),
456	!	filter_validation_rule = list(
457	!	paramcd = shinyvalidate::sv_required("An endpoint is required"),
458	!	visit_var = shinyvalidate::sv_required("A visit is required")
459		)
460		)
461
462	!	isolate({
463	!	resolved <- teal.transform::resolve_delayed(treatment_flag, as.list(data()@env))
464	!	teal.widgets::updateOptionalSelectInput(
465	!	session = session,
466	!	inputId = "treatment_flag",
467	!	choices = resolved$choices,
468	!	selected = resolved$selected
469		)
470		})
471
472	!	iv_r <- reactive({
473	!	iv <- shinyvalidate::InputValidator$new()
474	!	iv$add_rule(
475	!	"treatment_flag",
476	!	shinyvalidate::sv_required("An indicator value for on treatment records is required")
477		)
478	!	teal.transform::compose_and_enable_validators(iv, selector_list)
479		})
480
481	!	anl_inputs <- teal.transform::merge_expression_srv(
482	!	datasets = data,
483	!	selector_list = selector_list,
484	!	merge_function = "dplyr::inner_join"
485		)
486
487	!	adsl_inputs <- teal.transform::merge_expression_module(
488	!	datasets = data,
489	!	data_extract = list(arm_var = arm_var),
490	!	anl_name = "ANL_ADSL"
491		)
492
493	!	anl_q <- reactive({
494	!	data() %>%
495	!	teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
496	!	teal.code::eval_code(as.expression(adsl_inputs()$expr))
497		})
498
499	!	merged <- list(
500	!	anl_input_r = anl_inputs,
501	!	adsl_input_r = adsl_inputs,
502	!	anl_q = anl_q
503		)
504
505		# validate inputs
506	!	validate_checks <- reactive({
507	!	teal::validate_inputs(iv_r())
508
509	!	adsl_filtered <- merged$anl_q()[[parentname]]
510	!	anl_filtered <- merged$anl_q()[[dataname]]
511
512	!	input_arm_var <- names(merged$anl_input_r()$columns_source$arm_var)
513	!	input_aval_var <- names(merged$anl_input_r()$columns_source$aval_var)
514	!	input_baseline_var <- names(merged$anl_input_r()$columns_source$baseline_var)
515	!	input_treatment_flag_var <- names(merged$anl_input_r()$columns_source$treatment_flag_var)
516
517	!	validate(
518	!	need(
519	!	nrow(merged$anl_q()[["ANL"]]) > 0,
520	!	paste0(
521	!	"Please make sure the analysis dataset is not empty or\n",
522	!	"endpoint parameter and analysis visit are selected."
523		)
524		)
525		)
526
527	!	validate_standard_inputs(
528	!	adsl = adsl_filtered,
529	!	adslvars = c("USUBJID", "STUDYID", input_arm_var),
530	!	anl = anl_filtered,
531	!	anlvars = c("USUBJID", "STUDYID", input_aval_var, input_baseline_var),
532	!	arm_var = input_arm_var
533		)
534		})
535
536		# generate r code for the analysis
537	!	all_q <- reactive({
538	!	validate_checks()
539
540	!	my_calls <- template_shift_by_arm(
541	!	dataname = "ANL",
542	!	parentname = "ANL_ADSL",
543	!	arm_var = names(merged$anl_input_r()$columns_source$arm_var),
544	!	paramcd = unlist(merged$anl_input_r()$filter)["vars_selected"],
545	!	treatment_flag_var = names(merged$anl_input_r()$columns_source$treatment_flag_var),
546	!	treatment_flag = input$treatment_flag,
547	!	aval_var = names(merged$anl_input_r()$columns_source$aval_var),
548	!	baseline_var = names(merged$anl_input_r()$columns_source$baseline_var),
549	!	na.rm = ifelse(input$useNA == "ifany", FALSE, TRUE),
550	!	na_level = na_level,
551	!	add_total = input$add_total,
552	!	total_label = total_label,
553	!	basic_table_args = basic_table_args
554		)
555
556	!	teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
557		})
558
559		# Outputs to render.
560	!	table_r <- reactive(all_q()[["result"]])
561
562	!	teal.widgets::table_with_settings_srv(
563	!	id = "table",
564	!	table_r = table_r
565		)
566
567		# Render R code.
568	!	teal.widgets::verbatim_popup_srv(
569	!	id = "rcode",
570	!	verbatim_content = reactive(teal.code::get_code(all_q())),
571	!	title = label
572		)
573
574		### REPORTER
575	!	if (with_reporter) {
576	!	card_fun <- function(comment, label) {
577	!	card <- teal::report_card_template(
578	!	title = "Shift by Arm Table",
579	!	label = label,
580	!	with_filter = with_filter,
581	!	filter_panel_api = filter_panel_api
582		)
583	!	card$append_text("Table", "header3")
584	!	card$append_table(table_r())
585	!	if (!comment == "") {
586	!	card$append_text("Comment", "header3")
587	!	card$append_text(comment)
588		}
589	!	card$append_src(teal.code::get_code(all_q()))
590	!	card
591		}
592	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
593		}
594		###
595		})
596		}

1		#' Parse text input to numeric vector
2		#'
3		#' Generic to parse text into numeric vectors. This was initially designed
4		#' for a robust interpretation of text input in teal modules.
5		#'
6		#' @param str (`vector`)\cr to extract numeric from.
7		#' @details The function is intended to extract any numeric from a character
8		#' string, factor levels, boolean and return a vector of numeric.
9		#'
10		#' @md
11		#'
12		#' @return As vector of numeric if directly parsed from `numeric` or boolean.
13		#' A list of numeric if parsed from a character string, each character string
14		#' associated with an list item.
15		#'
16		#' @examples
17		#' dta <- list(
18		#' character = c("text10,20.5letter30.!", "!-.40$$-50e5[", NA),
19		#' factor = factor(c("]+60e-6, 7.7%%8L", "%90sep.100\"1L", NA_character_)),
20		#' numeric = c(1, -5e+2, NA),
21		#' logical = c(TRUE, FALSE, NA)
22		#' )
23		#' lapply(dta, as_num)
24		#' @export
25		as_num <- function(str) {
26	5x	UseMethod("as_num")
27		}
28
29		#' @export
30		#' @rdname as_num
31		as_num.default <- function(str) {
32	!	stop("No default implementation for `as_num.default`.")
33		}
34
35		#' @export
36		#' @rdname as_num
37		as_num.character <- function(str) {
38	2x	y <- regmatches(
39	2x	x = str,
40	2x	m = gregexpr(
41	2x	"[-+]?(\\d+(\\.\\d*)?\|\\.\\d+)([eE][-+]?\\d+)?",
42	2x	str,
43	2x	perl = TRUE
44		)
45		)
46
47	2x	y <- lapply(y, as.numeric)
48	2x	y[unlist(lapply(y, length) == 0)] <- NA
49
50	2x	return(y)
51		}
52
53		#' @export
54		#' @rdname as_num
55		as_num.numeric <- function(str) {
56	1x	return(str)
57		}
58
59		#' @export
60		#' @rdname as_num
61		as_num.factor <- function(str) {
62	1x	y <- as.character(str)
63	1x	y <- as_num(y)
64	1x	return(y)
65		}
66
67		#' @export
68		#' @rdname as_num
69		as_num.logical <- function(str) {
70	1x	y <- as.numeric(str)
71	1x	return(y)
72		}

1		#' Template: Event Rates Adjusted for Patient-Years
2		#'
3		#' Creates a valid expression to generate a table of event rates adjusted for patient-years.
4		#'
5		#' @inheritParams template_arguments
6		#' @param events_var (`character`)\cr name of the variable for number of observed events.
7		#' @param label_paramcd (`character`)\cr `paramcd` variable text to use in the table title.
8		#'
9		#' @inherit template_arguments return
10		#'
11		#' @seealso [tm_t_events_patyear()]
12		#'
13		#' @keywords internal
14		template_events_patyear <- function(dataname,
15		parentname,
16		arm_var,
17		events_var,
18		label_paramcd,
19		aval_var = "AVAL",
20		add_total = TRUE,
21		total_label = default_total_label(),
22		na_level = default_na_str(),
23		control = control_incidence_rate(),
24		drop_arm_levels = TRUE,
25		basic_table_args = teal.widgets::basic_table_args()) {
26	3x	checkmate::assert_character(arm_var, min.len = 1, max.len = 2)
27
28		# initialize
29	3x	y <- list()
30		# data
31	3x	data_list <- list()
32	3x	data_list <- add_expr(
33	3x	data_list,
34	3x	substitute(
35	3x	expr = anl <- df,
36	3x	env = list(df = as.name(dataname))
37		)
38		)
39	3x	data_list <- add_expr(
40	3x	data_list,
41	3x	prepare_arm_levels(
42	3x	dataname = "anl",
43	3x	parentname = parentname,
44	3x	arm_var = arm_var[[1]],
45	3x	drop_arm_levels = drop_arm_levels
46		)
47		)
48	3x	if (length(arm_var) == 2) {
49	1x	data_list <- add_expr(
50	1x	data_list,
51	1x	prepare_arm_levels(
52	1x	dataname = "anl",
53	1x	parentname = parentname,
54	1x	arm_var = arm_var[[2]],
55	1x	drop_arm_levels = drop_arm_levels
56		)
57		)
58		}
59
60	3x	data_list <- add_expr(
61	3x	data_list,
62	3x	substitute(
63	3x	expr = dataname <- df_explicit_na(dataname, na_level = na_str),
64	3x	env = list(dataname = as.name("anl"), na_str = na_level)
65		)
66		)
67	3x	data_list <- add_expr(
68	3x	data_list,
69	3x	substitute(
70	3x	expr = parentname <- df_explicit_na(parentname, na_level = na_str),
71	3x	env = list(parentname = as.name(parentname), na_str = na_level)
72		)
73		)
74
75	3x	y$data <- bracket_expr(data_list)
76
77		# layout
78	3x	layout_list <- list()
79
80	3x	basic_title <- tools::toTitleCase(paste("Event Rates Adjusted for Patient-Years by", label_paramcd))
81	3x	basic_footer <- paste(
82	3x	"CI Method:",
83	3x	if (control$conf_type == "normal") {
84	2x	"Normal (rate)"
85	3x	} else if (control$conf_type == "normal_log") {
86	!	"Normal (log rate)"
87	3x	} else if (control$conf_type == "exact") {
88	1x	"Exact"
89		} else {
90	!	"Byar's method"
91		}
92		)
93
94	3x	parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
95	3x	teal.widgets::resolve_basic_table_args(
96	3x	user_table = basic_table_args,
97	3x	module_table = teal.widgets::basic_table_args(
98	3x	show_colcounts = TRUE,
99	3x	title = basic_title,
100	3x	main_footer = basic_footer
101		)
102		)
103		)
104
105	3x	layout_list <- add_expr(
106	3x	layout_list,
107	3x	substitute(
108	3x	expr = expr_basic_table_args %>%
109	3x	rtables::split_cols_by(var = arm_var),
110	3x	env = list(arm_var = arm_var[[1]], expr_basic_table_args = parsed_basic_table_args)
111		)
112		)
113
114	3x	if (length(arm_var) == 2) {
115	1x	layout_list <- add_expr(
116	1x	layout_list,
117	1x	if (drop_arm_levels) {
118	1x	substitute(
119	1x	expr = rtables::split_cols_by(nested_col, split_fun = drop_split_levels),
120	1x	env = list(nested_col = arm_var[[2]])
121		)
122		} else {
123	!	substitute(
124	!	expr = rtables::split_cols_by(nested_col),
125	!	env = list(nested_col = arm_var[[2]])
126		)
127		}
128		)
129		}
130
131	3x	if (add_total) {
132	2x	layout_list <- add_expr(
133	2x	layout_list,
134	2x	substitute(
135	2x	expr = rtables::add_overall_col(label = total_label),
136	2x	env = list(total_label = total_label)
137		)
138		)
139		}
140	3x	layout_list <- add_expr(
141	3x	layout_list,
142	3x	substitute(
143	3x	expr = estimate_incidence_rate(
144	3x	vars = aval_var,
145	3x	n_events = events_var,
146	3x	control = control_incidence_rate(
147	3x	conf_level = conf_level,
148	3x	conf_type = conf_type,
149	3x	input_time_unit = input_time_unit,
150	3x	num_pt_year = num_pt_year
151		)
152		),
153	3x	env = list(
154	3x	aval_var = aval_var,
155	3x	events_var = events_var,
156	3x	conf_level = control$conf_level,
157	3x	conf_type = control$conf_type,
158	3x	input_time_unit = control$input_time_unit,
159	3x	num_pt_year = control$num_pt_year
160		)
161		)
162		)
163	3x	y$layout <- substitute(
164	3x	expr = lyt <- layout_pipe,
165	3x	env = list(layout_pipe = pipe_expr(layout_list))
166		)
167
168		# table
169	3x	y$table <- substitute(
170	3x	expr = {
171	!	result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent)
172	!	result
173		},
174	3x	env = list(parent = as.name(parentname))
175		)
176
177	3x	y
178		}
179
180		#' teal Module: Event Rates Adjusted for Patient-Years
181		#'
182		#' This module produces a table of event rates adjusted for patient-years.
183		#'
184		#' @inheritParams module_arguments
185		#' @inheritParams template_events_patyear
186		#' @param arm_var ([teal.transform::choices_selected()])\cr object with all
187		#' available choices and preselected option for variable names that can be used as `arm_var`.
188		#' It defines the grouping variable(s) in the results table.
189		#' If there are two elements selected for `arm_var`,
190		#' second variable will be nested under the first variable.
191		#' @param events_var ([teal.transform::choices_selected()])\cr object with
192		#' all available choices and preselected option for the variable with all event counts.
193		#'
194		#' @inherit module_arguments return seealso
195		#'
196		#' @examples
197		#' library(dplyr)
198		#'
199		#' ADSL <- tmc_ex_adsl
200		#' ADAETTE <- tmc_ex_adaette %>%
201		#' filter(PARAMCD %in% c("AETTE1", "AETTE2", "AETTE3")) %>%
202		#' mutate(is_event = CNSR == 0) %>%
203		#' mutate(n_events = as.integer(is_event))
204		#'
205		#' # 1. Basic Example
206		#'
207		#' app <- init(
208		#' data = cdisc_data(
209		#' ADSL = ADSL,
210		#' ADAETTE = ADAETTE,
211		#' code = "
212		#' ADSL <- tmc_ex_adsl
213		#' ADAETTE <- tmc_ex_adaette %>%
214		#' filter(PARAMCD %in% c(\"AETTE1\", \"AETTE2\", \"AETTE3\")) %>%
215		#' mutate(is_event = CNSR == 0) %>%
216		#' mutate(n_events = as.integer(is_event))
217		#' "
218		#' ),
219		#' modules = modules(
220		#' tm_t_events_patyear(
221		#' label = "AE Rate Adjusted for Patient-Years At Risk Table",
222		#' dataname = "ADAETTE",
223		#' arm_var = choices_selected(
224		#' choices = variable_choices(ADSL, c("ARM", "ARMCD")),
225		#' selected = "ARMCD"
226		#' ),
227		#' add_total = TRUE,
228		#' events_var = choices_selected(
229		#' choices = variable_choices(ADAETTE, "n_events"),
230		#' selected = "n_events",
231		#' fixed = TRUE
232		#' ),
233		#' paramcd = choices_selected(
234		#' choices = value_choices(ADAETTE, "PARAMCD", "PARAM"),
235		#' selected = "AETTE1"
236		#' )
237		#' )
238		#' )
239		#' )
240		#' if (interactive()) {
241		#' shinyApp(app$ui, app$server)
242		#' }
243		#'
244		#' # 2. Example with table split on 2 arm_var variables
245		#'
246		#' app <- init(
247		#' data = cdisc_data(
248		#' ADSL = ADSL,
249		#' ADAETTE = ADAETTE,
250		#' code = "
251		#' ADSL <- tmc_ex_adsl
252		#' ADAETTE <- tmc_ex_adaette %>%
253		#' filter(PARAMCD %in% c(\"AETTE1\", \"AETTE2\", \"AETTE3\")) %>%
254		#' mutate(is_event = CNSR == 0) %>%
255		#' mutate(n_events = as.integer(is_event))
256		#' "
257		#' ),
258		#' modules = modules(
259		#' tm_t_events_patyear(
260		#' label = "AE Rate Adjusted for Patient-Years At Risk Table",
261		#' dataname = "ADAETTE",
262		#' arm_var = choices_selected(
263		#' choices = variable_choices(ADSL, c("ARM", "ARMCD", "SEX")),
264		#' selected = c("ARM", "SEX")
265		#' ),
266		#' add_total = TRUE,
267		#' events_var = choices_selected(
268		#' choices = variable_choices(ADAETTE, "n_events"),
269		#' selected = "n_events",
270		#' fixed = TRUE
271		#' ),
272		#' paramcd = choices_selected(
273		#' choices = value_choices(ADAETTE, "PARAMCD", "PARAM"),
274		#' selected = "AETTE1"
275		#' )
276		#' )
277		#' )
278		#' )
279		#' if (interactive()) {
280		#' shinyApp(app$ui, app$server)
281		#' }
282		#'
283		#' @export
284		tm_t_events_patyear <- function(label,
285		dataname,
286		parentname = ifelse(
287		inherits(arm_var, "data_extract_spec"),
288		teal.transform::datanames_input(arm_var),
289		"ADSL"
290		),
291		arm_var,
292		events_var,
293		paramcd,
294		aval_var = teal.transform::choices_selected(
295		teal.transform::variable_choices(dataname, "AVAL"), "AVAL",
296		fixed = TRUE
297		),
298		avalu_var = teal.transform::choices_selected(
299		teal.transform::variable_choices(dataname, "AVALU"), "AVALU",
300		fixed = TRUE
301		),
302		add_total = TRUE,
303		total_label = default_total_label(),
304		na_level = default_na_str(),
305		conf_level = teal.transform::choices_selected(
306		c(0.95, 0.9, 0.8), 0.95,
307		keep_order = TRUE
308		),
309		drop_arm_levels = TRUE,
310		pre_output = NULL,
311		post_output = NULL,
312		basic_table_args = teal.widgets::basic_table_args()) {
313	!	message("Initializing tm_t_events_patyear")
314	!	checkmate::assert_string(label)
315	!	checkmate::assert_string(dataname)
316	!	checkmate::assert_string(parentname)
317	!	checkmate::assert_class(arm_var, "choices_selected")
318	!	checkmate::assert_class(events_var, "choices_selected")
319	!	checkmate::assert_class(paramcd, "choices_selected")
320	!	checkmate::assert_class(aval_var, "choices_selected")
321	!	checkmate::assert_class(avalu_var, "choices_selected")
322	!	checkmate::assert_class(conf_level, "choices_selected")
323	!	checkmate::assert_flag(add_total)
324	!	checkmate::assert_string(total_label)
325	!	checkmate::assert_string(na_level)
326	!	checkmate::assert_flag(drop_arm_levels)
327	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
328	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
329	!	checkmate::assert_class(basic_table_args, "basic_table_args")
330
331	!	args <- c(as.list(environment()))
332
333	!	data_extract_list <- list(
334	!	arm_var = cs_to_des_select(arm_var, dataname = parentname, multiple = TRUE, ordered = TRUE),
335	!	paramcd = cs_to_des_filter(paramcd, dataname = dataname),
336	!	aval_var = cs_to_des_select(aval_var, dataname = dataname),
337	!	avalu_var = cs_to_des_select(avalu_var, dataname = dataname),
338	!	events_var = cs_to_des_select(events_var, dataname = dataname)
339		)
340
341	!	module(
342	!	label = label,
343	!	ui = ui_events_patyear,
344	!	ui_args = c(data_extract_list, args),
345	!	server = srv_events_patyear,
346	!	server_args = c(
347	!	data_extract_list,
348	!	list(
349	!	dataname = dataname,
350	!	parentname = parentname,
351	!	label = label,
352	!	total_label = total_label,
353	!	na_level = na_level,
354	!	basic_table_args = basic_table_args
355		)
356		),
357	!	datanames = teal.transform::get_extract_datanames(data_extract_list)
358		)
359		}
360
361		#' @keywords internal
362		ui_events_patyear <- function(id, ...) {
363	!	ns <- NS(id)
364	!	a <- list(...)
365	!	is_single_dataset_value <- teal.transform::is_single_dataset(
366	!	a$arm_var, a$paramcd, a$aval_var, a$avalu_var, a$events_var
367		)
368
369	!	teal.widgets::standard_layout(
370	!	output = teal.widgets::white_small_well(teal.widgets::table_with_settings_ui(ns("patyear_table"))),
371	!	encoding = tags$div(
372		### Reporter
373	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
374		###
375	!	tags$label("Encodings", class = "text-primary"),
376	!	teal.transform::datanames_input(a[c("arm_var", "paramcd", "aval_var", "avalu_var", "events_var")]),
377	!	teal.transform::data_extract_ui(
378	!	id = ns("arm_var"),
379	!	label = "Select Treatment Variable",
380	!	data_extract_spec = a$arm_var,
381	!	is_single_dataset = is_single_dataset_value
382		),
383	!	checkboxInput(ns("add_total"), "Add All Patients column", value = a$add_total),
384	!	teal.transform::data_extract_ui(
385	!	id = ns("paramcd"),
386	!	label = "Select an Event Type Parameter",
387	!	data_extract_spec = a$paramcd,
388	!	is_single_dataset = is_single_dataset_value
389		),
390	!	teal.transform::data_extract_ui(
391	!	id = ns("aval_var"),
392	!	label = "Analysis Variable",
393	!	data_extract_spec = a$aval_var,
394	!	is_single_dataset = is_single_dataset_value
395		),
396	!	teal.transform::data_extract_ui(
397	!	id = ns("events_var"),
398	!	label = "Event Variable",
399	!	data_extract_spec = a$events_var,
400	!	is_single_dataset = is_single_dataset_value
401		),
402	!	teal.transform::data_extract_ui(
403	!	id = ns("avalu_var"),
404	!	label = "Analysis Unit Variable",
405	!	data_extract_spec = a$avalu_var,
406	!	is_single_dataset = is_single_dataset_value
407		),
408	!	teal.widgets::optionalSelectInput(
409	!	inputId = ns("conf_level"),
410	!	label = "Confidence Level",
411	!	a$conf_level$choices,
412	!	a$conf_level$selected,
413	!	multiple = FALSE,
414	!	fixed = a$conf_level$fixed
415		),
416	!	teal.widgets::optionalSelectInput(
417	!	ns("conf_method"),
418	!	"CI Method",
419	!	choices = c("Normal (rate)", "Normal (log rate)", "Exact", "Byar's method"),
420	!	selected = "Normal (rate)",
421	!	multiple = FALSE,
422	!	fixed = FALSE
423		),
424	!	teal.widgets::panel_group(
425	!	teal.widgets::panel_item(
426	!	"Additional table settings",
427	!	checkboxInput(
428	!	ns("drop_arm_levels"),
429	!	label = "Drop columns not in filtered analysis dataset",
430	!	value = a$drop_arm_levels
431		),
432	!	teal.widgets::optionalSelectInput(
433	!	ns("num_pt_year"),
434	!	"Time Unit for AE Rate (in Patient-Years)",
435	!	choices = c(0.1, 1, 10, 100, 1000),
436	!	selected = 100,
437	!	multiple = FALSE,
438	!	fixed = FALSE
439		),
440	!	selectInput(
441	!	ns("input_time_unit"),
442	!	"Analysis Unit",
443	!	choices = NULL,
444	!	selected = NULL,
445	!	multiple = FALSE
446		)
447		)
448		)
449		),
450	!	forms = tagList(
451	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
452		),
453	!	pre_output = a$pre_output,
454	!	post_output = a$post_output
455		)
456		}
457
458		#' @keywords internal
459		srv_events_patyear <- function(id,
460		data,
461		reporter,
462		filter_panel_api,
463		dataname,
464		parentname,
465		arm_var,
466		paramcd,
467		aval_var,
468		avalu_var,
469		events_var,
470		add_total,
471		total_label,
472		na_level,
473		drop_arm_levels,
474		label,
475		basic_table_args) {
476	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
477	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
478	!	checkmate::assert_class(data, "reactive")
479	!	checkmate::assert_class(shiny::isolate(data()), "teal_data")
480
481	!	moduleServer(id, function(input, output, session) {
482	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
483	!	observeEvent(anl_q(), {
484	!	data_anl <- merged$anl_q()[["ANL"]]
485	!	aval_unit_var <- merged$anl_input_r()$columns_source$avalu_var
486	!	if (length(aval_unit_var) > 0) {
487	!	choices <- stats::na.omit(unique(data_anl[[aval_unit_var]]))
488	!	choices <- gsub("s$", "", tolower(choices))
489
490	!	updateSelectInput(
491	!	session,
492	!	"input_time_unit",
493	!	choices = choices,
494	!	selected = choices[1]
495		)
496		}
497		})
498
499	!	selector_list <- teal.transform::data_extract_multiple_srv(
500	!	data_extract = list(
501	!	arm_var = arm_var,
502	!	paramcd = paramcd,
503	!	aval_var = aval_var,
504	!	avalu_var = avalu_var,
505	!	events_var = events_var
506		),
507	!	datasets = data,
508	!	select_validation_rule = list(
509	!	arm_var = ~ if (length(.) != 1 && length(.) != 2) "Please select exactly 1 or 2 treatment variables",
510	!	aval_var = shinyvalidate::sv_required("Analysis Variable is required"),
511	!	events_var = shinyvalidate::sv_required("Events Variable is required")
512		),
513	!	filter_validation_rule = list(
514	!	paramcd = shinyvalidate::sv_required("A Event Type Parameter is required")
515		)
516		)
517
518	!	iv_r <- reactive({
519	!	iv <- shinyvalidate::InputValidator$new()
520	!	iv$add_rule("conf_level", shinyvalidate::sv_required("Please choose a confidence level"))
521	!	iv$add_rule(
522	!	"conf_level",
523	!	shinyvalidate::sv_between(
524	!	0, 1,
525	!	inclusive = c(FALSE, FALSE),
526	!	message_fmt = "Confidence level must be between 0 and 1"
527		)
528		)
529	!	iv$add_rule("conf_method", shinyvalidate::sv_required("A CI method is required"))
530	!	iv$add_rule("num_pt_year", shinyvalidate::sv_required("Time Unit for AE Rate is required"))
531	!	teal.transform::compose_and_enable_validators(iv, selector_list)
532		})
533
534	!	anl_inputs <- teal.transform::merge_expression_srv(
535	!	datasets = data,
536	!	selector_list = selector_list,
537	!	merge_function = "dplyr::inner_join"
538		)
539
540	!	adsl_inputs <- teal.transform::merge_expression_module(
541	!	datasets = data,
542	!	data_extract = list(arm_var = arm_var),
543	!	anl_name = "ANL_ADSL"
544		)
545
546	!	anl_q <- reactive({
547	!	data() %>%
548	!	teal.code::eval_code(as.expression(anl_inputs()$expr)) %>%
549	!	teal.code::eval_code(as.expression(adsl_inputs()$expr))
550		})
551
552	!	merged <- list(
553	!	anl_input_r = anl_inputs,
554	!	adsl_input_r = adsl_inputs,
555	!	anl_q = anl_q
556		)
557
558		# Prepare the analysis environment (filter data, check data, populate envir).
559	!	validate_checks <- reactive({
560	!	teal::validate_inputs(iv_r())
561	!	adsl_filtered <- merged$anl_q()[[parentname]]
562	!	anl_filtered <- merged$anl_q()[[dataname]]
563
564	!	input_arm_var <- as.vector(merged$anl_input_r()$columns_source$arm_var)
565	!	input_aval_var <- as.vector(merged$anl_input_r()$columns_source$aval_var)
566	!	input_avalu_var <- as.vector(merged$anl_input_r()$columns_source$avalu_var)
567	!	input_events_var <- as.vector(merged$anl_input_r()$columns_source$events_var)
568	!	input_paramcd <- unlist(paramcd$filter)["vars_selected"]
569
570		# validate inputs
571	!	validate_standard_inputs(
572	!	adsl = adsl_filtered,
573	!	adslvars = c("USUBJID", "STUDYID", input_arm_var),
574	!	anl = anl_filtered,
575	!	anlvars = c("USUBJID", "STUDYID", input_paramcd, input_events_var, input_aval_var, input_avalu_var),
576	!	arm_var = input_arm_var[[1]]
577		)
578
579	!	validate(
580	!	need(
581	!	!any(is.na(merged$anl_q()[["ANL"]][[input_events_var]])),
582	!	"`Event Variable` for selected parameter includes NA values."
583		)
584		)
585	!	NULL
586		})
587
588		# The R-code corresponding to the analysis.
589	!	table_q <- reactive({
590	!	validate_checks()
591
592	!	ANL <- merged$anl_q()[["ANL"]]
593	!	label_paramcd <- get_paramcd_label(ANL, paramcd)
594
595	!	my_calls <- template_events_patyear(
596	!	dataname = "ANL",
597	!	parentname = "ANL_ADSL",
598	!	arm_var = as.vector(merged$anl_input_r()$columns_source$arm_var),
599	!	aval_var = as.vector(merged$anl_input_r()$columns_source$aval_var),
600	!	events_var = as.vector(merged$anl_input_r()$columns_source$events_var),
601	!	label_paramcd = label_paramcd,
602	!	add_total = input$add_total,
603	!	total_label = total_label,
604	!	na_level = na_level,
605	!	control = control_incidence_rate(
606	!	conf_level = as.numeric(input$conf_level),
607	!	conf_type = if (input$conf_method == "Normal (rate)") {
608	!	"normal"
609	!	} else if (input$conf_method == "Normal (log rate)") {
610	!	"normal_log"
611	!	} else if (input$conf_method == "Exact") {
612	!	"exact"
613		} else {
614	!	"byar"
615		},
616	!	input_time_unit = if (input$input_time_unit %in% c("day", "week", "month", "year")) {
617	!	input$input_time_unit
618		} else {
619	!	"year"
620		},
621	!	num_pt_year = as.numeric(input$num_pt_year)
622		),
623	!	drop_arm_levels = input$drop_arm_levels,
624	!	basic_table_args = basic_table_args
625		)
626	!	teal.code::eval_code(merged$anl_q(), as.expression(my_calls))
627		})
628
629		# Outputs to render.
630	!	table_r <- reactive({
631	!	table_q()[["result"]]
632		})
633
634	!	teal.widgets::table_with_settings_srv(
635	!	id = "patyear_table",
636	!	table_r = table_r
637		)
638
639		# Render R code.
640	!	teal.widgets::verbatim_popup_srv(
641	!	id = "rcode",
642	!	verbatim_content = reactive(teal.code::get_code(table_q())),
643	!	title = label
644		)
645
646		### REPORTER
647	!	if (with_reporter) {
648	!	card_fun <- function(comment, label) {
649	!	card <- teal::report_card_template(
650	!	title = "Event Rates Adjusted For Patient-Years Table",
651	!	label = label,
652	!	with_filter = with_filter,
653	!	filter_panel_api = filter_panel_api
654		)
655	!	card$append_text("Table", "header3")
656	!	card$append_table(table_r())
657	!	if (!comment == "") {
658	!	card$append_text("Comment", "header3")
659	!	card$append_text(comment)
660		}
661	!	card$append_src(teal.code::get_code(table_q()))
662	!	card
663		}
664	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
665		}
666		###
667		})
668		}

1		#' Template: Patient Profile Adverse Events Table and Plot
2		#'
3		#' Creates a valid expression to generate an adverse events table and [ggplot2::ggplot()] plot using ADaM datasets.
4		#'
5		#' @inheritParams template_arguments
6		#' @param aeterm (`character`)\cr name of the reported term for the adverse event variable.
7		#' @param tox_grade (`character`)\cr name of the standard toxicity grade variable.
8		#' @param causality (`character`)\cr name of the causality variable.
9		#' @param outcome (`character`)\cr name of outcome of adverse event variable.
10		#' @param action (`character`)\cr name of action taken with study treatment variable.
11		#' @param time (`character`)\cr name of study day of start of adverse event variable.
12		#' @param decod (`character`)\cr name of dictionary derived term variable.
13		#'
14		#' @inherit template_arguments return
15		#'
16		#' @seealso [tm_g_pp_adverse_events()]
17		#'
18		#' @keywords internal
19		template_adverse_events <- function(dataname = "ANL",
20		aeterm = "AETERM",
21		tox_grade = "AETOXGR",
22		causality = "AEREL",
23		outcome = "AEOUT",
24		action = "AEACN",
25		time = "ASTDY",
26		decod = NULL,
27		patient_id,
28		font_size = 12L,
29		ggplot2_args = teal.widgets::ggplot2_args()) {
30	!	checkmate::assert_string(dataname)
31	!	checkmate::assert_string(aeterm)
32	!	checkmate::assert_string(tox_grade)
33	!	checkmate::assert_string(causality)
34	!	checkmate::assert_string(outcome)
35	!	checkmate::assert_string(action)
36	!	checkmate::assert_string(time, null.ok = TRUE)
37	!	checkmate::assert_string(decod, null.ok = TRUE)
38	!	checkmate::assert_string(patient_id)
39	!	checkmate::assert_number(font_size)
40
41	!	y <- list()
42
43	!	y$table <- list()
44	!	y$chart <- list()
45
46	!	table_list <- add_expr(
47	!	list(),
48	!	substitute(
49	!	expr = {
50	!	table <- dataname %>%
51	!	dplyr::select(
52	!	aeterm, tox_grade, causality, outcome, action, time, decod
53		) %>%
54	!	dplyr::arrange(dplyr::desc(tox_grade)) %>%
55	!	`colnames<-`(col_labels(dataname, fill = TRUE)[vars])
56
57	!	table <- rlistings::as_listing(
58	!	table,
59	!	key_cols = NULL,
60	!	default_formatting = list(all = fmt_config(align = "left"))
61		)
62	!	main_title(table) <- paste("Patient ID:", patient_id)
63
64	!	table
65		},
66	!	env = list(
67	!	dataname = as.name(dataname),
68	!	aeterm = as.name(aeterm),
69	!	tox_grade = as.name(tox_grade),
70	!	causality = as.name(causality),
71	!	outcome = as.name(outcome),
72	!	action = as.name(action),
73	!	time = as.name(time),
74	!	decod = `if`(is.null(decod), NULL, as.name(decod)),
75	!	vars = c(aeterm, tox_grade, causality, outcome, action, time, decod),
76	!	patient_id = patient_id
77		)
78		)
79		)
80
81	!	parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args(
82	!	teal.widgets::resolve_ggplot2_args(
83	!	user_plot = ggplot2_args,
84	!	module_plot = teal.widgets::ggplot2_args(
85	!	labs = list(y = "Adverse Events", title = paste0("Patient ID: ", patient_id)),
86	!	theme = list(
87	!	text = substitute(ggplot2::element_text(size = font), list(font = font_size[1])),
88	!	axis.text.y = quote(ggplot2::element_blank()),
89	!	axis.ticks.y = quote(ggplot2::element_blank()),
90	!	legend.position = "right",
91	!	panel.grid.minor = quote(ggplot2::element_line(
92	!	linewidth = 0.5,
93	!	linetype = "dotted",
94	!	colour = "grey"
95		)),
96	!	panel.grid.major = quote(ggplot2::element_line(
97	!	linewidth = 0.5,
98	!	linetype = "dotted",
99	!	colour = "grey"
100		))
101		)
102		)
103		)
104		)
105
106	!	chart_list <- add_expr(
107	!	list(),
108	!	substitute(
109	!	expr = plot <- dataname %>%
110	!	dplyr::select(aeterm, time, tox_grade, causality) %>%
111	!	dplyr::mutate(ATOXGR = as.character(tox_grade)) %>%
112	!	dplyr::arrange(dplyr::desc(ATOXGR)) %>%
113	!	dplyr::mutate(ATOXGR = dplyr::case_when(
114	!	ATOXGR == "." ~ "UNKNOWN",
115	!	TRUE ~ ATOXGR
116		)) %>%
117	!	ggplot2::ggplot(ggplot2::aes(
118	!	fill = ATOXGR, color = aeterm, y = aeterm, x = time
119		)) +
120	!	ggrepel::geom_label_repel(
121	!	ggplot2::aes(label = aeterm),
122	!	color = "black",
123	!	hjust = "right",
124	!	size = font_size_var[1] / 3.5,
125	!	show.legend = FALSE
126		) +
127	!	ggplot2::scale_fill_manual(values = c(
128	!	"1" = "#E2264633",
129	!	"2" = "#E2264666",
130	!	"3" = "#E2264699",
131	!	"4" = "#E22646CC",
132	!	"5" = "#E22646FF",
133	!	"UNKNOWN" = "#ACADB1FF"
134		)) +
135	!	ggplot2::scale_y_discrete(expand = ggplot2::expansion(add = 1.2)) +
136	!	ggplot2::xlim(1, 1.2 * max(dataname[[time_var]])) +
137	!	ggplot2::geom_point(color = "black", size = 2, shape = 24, position = ggplot2::position_nudge(y = -0.15)) +
138	!	labs +
139	!	themes,
140	!	env = list(
141	!	dataname = as.name(dataname),
142	!	aeterm = as.name(aeterm),
143	!	time = as.name(time),
144	!	tox_grade = as.name(tox_grade),
145	!	causality = as.name(causality),
146	!	time_var = time,
147	!	font_size_var = font_size,
148	!	patient_id = patient_id,
149	!	labs = parsed_ggplot2_args$labs,
150	!	themes = parsed_ggplot2_args$theme
151		)
152		)
153		)
154
155	!	chart_list <- add_expr(
156	!	expr_ls = chart_list,
157	!	new_expr = quote(print(plot))
158		)
159
160	!	y$table <- bracket_expr(table_list)
161	!	y$chart <- bracket_expr(chart_list)
162
163	!	y
164		}
165
166		#' teal Module: Patient Profile Adverse Events Table and Plot
167		#'
168		#' This module produces an adverse events table and [ggplot2::ggplot()] type plot using ADaM datasets.
169		#'
170		#' @inheritParams module_arguments
171		#' @inheritParams template_adverse_events
172		#' @param aeterm ([teal.transform::choices_selected()])\cr object with all
173		#' available choices and preselected option for the `AETERM` variable from `dataname`.
174		#' @param tox_grade ([teal.transform::choices_selected()])\cr object with all
175		#' available choices and preselected option for the `AETOXGR` variable from `dataname`.
176		#' @param causality ([teal.transform::choices_selected()])\cr object with all
177		#' available choices and preselected option for the `AEREL` variable from `dataname`.
178		#' @param outcome ([teal.transform::choices_selected()])\cr object with all
179		#' available choices and preselected option for the `AEOUT` variable from `dataname`.
180		#' @param action ([teal.transform::choices_selected()])\cr object with all
181		#' available choices and preselected option for the `AEACN` variable from `dataname`.
182		#' @param time ([teal.transform::choices_selected()])\cr object with all
183		#' available choices and preselected option for the `ASTDY` variable from `dataname`.
184		#' @param decod ([teal.transform::choices_selected()])\cr object with all
185		#' available choices and preselected option for the `AEDECOD` variable from `dataname`.
186		#'
187		#' @inherit module_arguments return
188		#'
189		#' @examples
190		#' library(nestcolor)
191		#' library(dplyr)
192		#'
193		#' ADAE <- tmc_ex_adae
194		#' ADSL <- tmc_ex_adsl %>% filter(USUBJID %in% ADAE$USUBJID)
195		#'
196		#' app <- init(
197		#' data = cdisc_data(
198		#' ADSL = ADSL,
199		#' ADAE = ADAE,
200		#' code = "
201		#' ADAE <- tmc_ex_adae
202		#' ADSL <- tmc_ex_adsl %>% filter(USUBJID %in% ADAE$USUBJID)
203		#' "
204		#' ),
205		#' modules = modules(
206		#' tm_g_pp_adverse_events(
207		#' label = "Adverse Events",
208		#' dataname = "ADAE",
209		#' parentname = "ADSL",
210		#' patient_col = "USUBJID",
211		#' plot_height = c(600L, 200L, 2000L),
212		#' aeterm = choices_selected(
213		#' choices = variable_choices(ADAE, "AETERM"),
214		#' selected = "AETERM"
215		#' ),
216		#' tox_grade = choices_selected(
217		#' choices = variable_choices(ADAE, "AETOXGR"),
218		#' selected = "AETOXGR"
219		#' ),
220		#' causality = choices_selected(
221		#' choices = variable_choices(ADAE, "AEREL"),
222		#' selected = "AEREL"
223		#' ),
224		#' outcome = choices_selected(
225		#' choices = variable_choices(ADAE, "AEOUT"),
226		#' selected = "AEOUT"
227		#' ),
228		#' action = choices_selected(
229		#' choices = variable_choices(ADAE, "AEACN"),
230		#' selected = "AEACN"
231		#' ),
232		#' time = choices_selected(
233		#' choices = variable_choices(ADAE, "ASTDY"),
234		#' selected = "ASTDY"
235		#' ),
236		#' decod = NULL
237		#' )
238		#' )
239		#' )
240		#' if (interactive()) {
241		#' shinyApp(app$ui, app$server)
242		#' }
243		#'
244		#' @export
245		tm_g_pp_adverse_events <- function(label,
246		dataname = "ADAE",
247		parentname = "ADSL",
248		patient_col = "USUBJID",
249		aeterm = NULL,
250		tox_grade = NULL,
251		causality = NULL,
252		outcome = NULL,
253		action = NULL,
254		time = NULL,
255		decod = NULL,
256		font_size = c(12L, 12L, 25L),
257		plot_height = c(700L, 200L, 2000L),
258		plot_width = NULL,
259		pre_output = NULL,
260		post_output = NULL,
261		ggplot2_args = teal.widgets::ggplot2_args()) {
262	!	message("Initializing tm_g_pp_adverse_events")
263	!	checkmate::assert_string(label)
264	!	checkmate::assert_string(dataname)
265	!	checkmate::assert_string(parentname)
266	!	checkmate::assert_string(patient_col)
267	!	checkmate::assert_class(aeterm, "choices_selected", null.ok = TRUE)
268	!	checkmate::assert_class(tox_grade, "choices_selected", null.ok = TRUE)
269	!	checkmate::assert_class(causality, "choices_selected", null.ok = TRUE)
270	!	checkmate::assert_class(outcome, "choices_selected", null.ok = TRUE)
271	!	checkmate::assert_class(action, "choices_selected", null.ok = TRUE)
272	!	checkmate::assert_class(time, "choices_selected", null.ok = TRUE)
273	!	checkmate::assert_class(decod, "choices_selected", null.ok = TRUE)
274	!	checkmate::assert_numeric(font_size, len = 3, any.missing = FALSE, finite = TRUE)
275	!	checkmate::assert_numeric(font_size[1], lower = font_size[2], upper = font_size[3], .var.name = "font_size")
276	!	checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
277	!	checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
278	!	checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
279	!	checkmate::assert_numeric(
280	!	plot_width[1],
281	!	lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
282		)
283	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
284	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
285	!	checkmate::assert_class(ggplot2_args, "ggplot2_args")
286
287	!	args <- as.list(environment())
288	!	data_extract_list <- list(
289	!	aeterm = `if`(is.null(aeterm), NULL, cs_to_des_select(aeterm, dataname = dataname)),
290	!	tox_grade = `if`(is.null(tox_grade), NULL, cs_to_des_select(tox_grade, dataname = dataname)),
291	!	causality = `if`(is.null(causality), NULL, cs_to_des_select(causality, dataname = dataname)),
292	!	outcome = `if`(is.null(outcome), NULL, cs_to_des_select(outcome, dataname = dataname)),
293	!	action = `if`(is.null(action), NULL, cs_to_des_select(action, dataname = dataname)),
294	!	time = `if`(is.null(time), NULL, cs_to_des_select(time, dataname = dataname)),
295	!	decod = `if`(is.null(decod), NULL, cs_to_des_select(decod, dataname = dataname))
296		)
297
298	!	module(
299	!	label = label,
300	!	ui = ui_g_adverse_events,
301	!	ui_args = c(data_extract_list, args),
302	!	server = srv_g_adverse_events,
303	!	server_args = c(
304	!	data_extract_list,
305	!	list(
306	!	dataname = dataname,
307	!	parentname = parentname,
308	!	label = label,
309	!	patient_col = patient_col,
310	!	plot_height = plot_height,
311	!	plot_width = plot_width,
312	!	ggplot2_args = ggplot2_args
313		)
314		),
315	!	datanames = c(dataname, parentname)
316		)
317		}
318
319		#' @keywords internal
320		ui_g_adverse_events <- function(id, ...) {
321	!	ui_args <- list(...)
322	!	is_single_dataset_value <- teal.transform::is_single_dataset(
323	!	ui_args$aeterm,
324	!	ui_args$tox_grade,
325	!	ui_args$causality,
326	!	ui_args$outcome,
327	!	ui_args$action,
328	!	ui_args$time,
329	!	ui_args$decod
330		)
331
332	!	ns <- NS(id)
333	!	teal.widgets::standard_layout(
334	!	output = tags$div(
335	!	htmlOutput(ns("title")),
336	!	teal.widgets::get_dt_rows(ns("table"), ns("table_rows")),
337	!	DT::DTOutput(outputId = ns("table")),
338	!	teal.widgets::plot_with_settings_ui(id = ns("chart"))
339		),
340	!	encoding = tags$div(
341		### Reporter
342	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
343		###
344	!	tags$label("Encodings", class = "text-primary"),
345	!	teal.transform::datanames_input(ui_args[c(
346	!	"aeterm", "tox_grade", "causality", "outcome",
347	!	"action", "time", "decod"
348		)]),
349	!	teal.widgets::optionalSelectInput(
350	!	ns("patient_id"),
351	!	"Select Patient:",
352	!	multiple = FALSE,
353	!	options = shinyWidgets::pickerOptions(`liveSearch` = TRUE)
354		),
355	!	teal.transform::data_extract_ui(
356	!	id = ns("aeterm"),
357	!	label = "Select AETERM variable:",
358	!	data_extract_spec = ui_args$aeterm,
359	!	is_single_dataset = is_single_dataset_value
360		),
361	!	teal.transform::data_extract_ui(
362	!	id = ns("tox_grade"),
363	!	label = "Select AETOXGR variable:",
364	!	data_extract_spec = ui_args$tox_grade,
365	!	is_single_dataset = is_single_dataset_value
366		),
367	!	teal.transform::data_extract_ui(
368	!	id = ns("causality"),
369	!	label = "Select AEREL variable:",
370	!	data_extract_spec = ui_args$causality,
371	!	is_single_dataset = is_single_dataset_value
372		),
373	!	teal.transform::data_extract_ui(
374	!	id = ns("outcome"),
375	!	label = "Select AEOUT variable:",
376	!	data_extract_spec = ui_args$outcome,
377	!	is_single_dataset = is_single_dataset_value
378		),
379	!	teal.transform::data_extract_ui(
380	!	id = ns("action"),
381	!	label = "Select AEACN variable:",
382	!	data_extract_spec = ui_args$action,
383	!	is_single_dataset = is_single_dataset_value
384		),
385	!	teal.transform::data_extract_ui(
386	!	id = ns("time"),
387	!	label = "Select ASTDY variable:",
388	!	data_extract_spec = ui_args$time,
389	!	is_single_dataset = is_single_dataset_value
390		),
391	!	`if`(
392	!	is.null(ui_args$decod),
393	!	NULL,
394	!	teal.transform::data_extract_ui(
395	!	id = ns("decod"),
396	!	label = "Select DECOD variable:",
397	!	data_extract_spec = ui_args$decod,
398	!	is_single_dataset = is_single_dataset_value
399		)
400		),
401	!	teal.widgets::panel_item(
402	!	title = "Plot settings",
403	!	collapsed = TRUE,
404	!	teal.widgets::optionalSliderInputValMinMax(
405	!	ns("font_size"),
406	!	"Font Size",
407	!	ui_args$font_size,
408	!	ticks = FALSE, step = 1
409		)
410		)
411		),
412	!	forms = tagList(
413	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
414		),
415	!	pre_output = ui_args$pre_output,
416	!	post_output = ui_args$post_output
417		)
418		}
419
420		#' @keywords internal
421		srv_g_adverse_events <- function(id,
422		data,
423		filter_panel_api,
424		reporter,
425		dataname,
426		parentname,
427		patient_col,
428		aeterm,
429		tox_grade,
430		causality,
431		outcome,
432		action,
433		time,
434		decod,
435		plot_height,
436		plot_width,
437		label,
438		ggplot2_args) {
439	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
440	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
441	!	checkmate::assert_class(data, "reactive")
442	!	checkmate::assert_class(isolate(data()), "teal_data")
443
444	!	moduleServer(id, function(input, output, session) {
445	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
446	!	patient_id <- reactive(input$patient_id)
447
448		# Init
449	!	patient_data_base <- reactive(unique(data()[[parentname]][[patient_col]]))
450	!	teal.widgets::updateOptionalSelectInput(
451	!	session,
452	!	"patient_id",
453	!	choices = patient_data_base(),
454	!	selected = patient_data_base()[1]
455		)
456
457	!	observeEvent(patient_data_base(),
458	!	handlerExpr = {
459	!	teal.widgets::updateOptionalSelectInput(
460	!	session,
461	!	"patient_id",
462	!	choices = patient_data_base(),
463	!	selected = if (length(patient_data_base()) == 1) {
464	!	patient_data_base()
465		} else {
466	!	intersect(patient_id(), patient_data_base())
467		}
468		)
469		},
470	!	ignoreInit = TRUE
471		)
472
473		# Adverse events tab ----
474	!	selector_list <- teal.transform::data_extract_multiple_srv(
475	!	data_extract = Filter(
476	!	Negate(is.null),
477	!	list(
478	!	aeterm = aeterm,
479	!	tox_grade = tox_grade,
480	!	causality = causality,
481	!	outcome = outcome,
482	!	action = action,
483	!	time = time,
484	!	decod = decod
485		)
486		),
487	!	datasets = data,
488	!	select_validation_rule = list(
489	!	aeterm = shinyvalidate::sv_required("Please select AETERM variable."),
490	!	tox_grade = shinyvalidate::sv_required("Please select AETOXGR variable."),
491	!	causality = shinyvalidate::sv_required("Please select AEREL variable."),
492	!	outcome = shinyvalidate::sv_required("Please select AEOUT variable."),
493	!	action = shinyvalidate::sv_required("Please select AEACN variable."),
494	!	time = shinyvalidate::sv_required("Please select ASTDY variable."),
495	!	decod = shinyvalidate::sv_required("Please select ANRIND variable.")
496		)
497		)
498
499	!	iv_r <- reactive({
500	!	iv <- shinyvalidate::InputValidator$new()
501	!	iv$add_rule("patient_id", shinyvalidate::sv_required("Please select a patient"))
502	!	teal.transform::compose_and_enable_validators(iv, selector_list)
503		})
504
505	!	anl_inputs <- teal.transform::merge_expression_srv(
506	!	datasets = data,
507	!	selector_list = selector_list
508		)
509
510	!	anl_q <- reactive(
511	!	data() %>%
512	!	teal.code::eval_code(as.expression(anl_inputs()$expr))
513		)
514
515	!	all_q <- reactive({
516	!	teal::validate_inputs(iv_r())
517	!	anl_m <- anl_inputs()
518
519	!	ANL <- anl_q()[["ANL"]]
520
521	!	teal::validate_has_data(ANL[ANL[[patient_col]] == input$patient_id, ], min_nrow = 1)
522
523	!	anl_q2 <- teal.code::eval_code(
524	!	anl_q(),
525	!	substitute(
526	!	expr = {
527	!	pt_id <- patient_id
528	!	ANL <- ANL[ANL[[patient_col]] == patient_id, ]
529	!	}, env = list(
530	!	patient_col = patient_col,
531	!	patient_id = patient_id()
532		)
533		)
534		)
535
536	!	calls <- template_adverse_events(
537	!	dataname = "ANL",
538	!	aeterm = input[[extract_input("aeterm", dataname)]],
539	!	tox_grade = input[[extract_input("tox_grade", dataname)]],
540	!	causality = input[[extract_input("causality", dataname)]],
541	!	outcome = input[[extract_input("outcome", dataname)]],
542	!	action = input[[extract_input("action", dataname)]],
543	!	time = input[[extract_input("time", dataname)]],
544	!	decod = input[[extract_input("decod", dataname)]],
545	!	patient_id = patient_id(),
546	!	font_size = input[["font_size"]],
547	!	ggplot2_args = ggplot2_args
548		)
549
550	!	teal.code::eval_code(anl_q2, as.expression(calls))
551		})
552
553	!	output$title <- renderText({
554	!	paste("<h5><b>Patient ID:", all_q()[["pt_id"]], "</b></h5>")
555		})
556
557	!	output$table <- DT::renderDataTable(
558	!	expr = teal.code::dev_suppress(all_q()[["table"]]),
559	!	options = list(pageLength = input$table_rows)
560		)
561
562	!	plot_r <- reactive({
563	!	req(iv_r()$is_valid())
564	!	all_q()[["plot"]]
565		})
566
567	!	pws <- teal.widgets::plot_with_settings_srv(
568	!	id = "chart",
569	!	plot_r = plot_r,
570	!	height = plot_height,
571	!	width = plot_width
572		)
573
574	!	teal.widgets::verbatim_popup_srv(
575	!	id = "rcode",
576	!	verbatim_content = reactive(teal.code::get_code(all_q())),
577	!	title = label
578		)
579
580		### REPORTER
581	!	if (with_reporter) {
582	!	card_fun <- function(comment, label) {
583	!	card <- teal::report_card_template(
584	!	title = "Patient Profile Adverse Events Plot",
585	!	label = label,
586	!	with_filter = with_filter,
587	!	filter_panel_api = filter_panel_api
588		)
589	!	card$append_text("Table", "header3")
590	!	card$append_table(teal.code::dev_suppress(all_q()[["table"]]))
591	!	card$append_text("Plot", "header3")
592	!	card$append_plot(plot_r(), dim = pws$dim())
593	!	if (!comment == "") {
594	!	card$append_text("Comment", "header3")
595	!	card$append_text(comment)
596		}
597	!	card$append_src(teal.code::get_code(all_q()))
598	!	card
599		}
600	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
601		}
602		###
603		})
604		}

1		#' Observer for Treatment reference variable
2		#'
3		#' @description `r lifecycle::badge("stable")`
4		#' Updates the reference and comparison Treatments when the selected Treatment variable changes
5		#'
6		#' @param session (`environment`)\cr shiny session
7		#' @param input (`character`)\cr shiny input
8		#' @param output (`character`)\cr shiny input
9		#' @param id_ref (`character`)\cr id of reference Treatment input UI element
10		#' @param id_comp (`character`)\cr id of comparison group input UI element
11		#' @param id_arm_var (`character`)\cr id of Treatment variable input UI element
12		#' @param data (`reactive` or `data.frame`)\cr dataset used to validate Treatment reference inputs and
13		#' set `id_ref` input.
14		#' @param arm_ref_comp (`unknown`)\cr Treatment reference and compare variables provided as a
15		#' nested list where each Treatment variable corresponds a list specifying the default levels for the
16		#' reference and comparison treatments.
17		#' @param module (`character`)\cr name of the module where this is called (this is only used
18		#' to produce more informative error messages)
19		#' @param on_off (`logical`)\cr A reactive that can be used to
20		#' stop the whole observer if `FALSE`.
21		#' @param input_id (`character`)\cr unique id that the buckets will be referenced with.
22		#' @param output_id (`character`)\cr name of the UI id that the output will be written to.
23		#' @return Returns a `shinyvalidate::InputValidator` which checks that there is at least one reference
24		#' and comparison arm
25		#' @keywords internal
26		#'
27		arm_ref_comp_observer <- function(session,
28		input,
29		output,
30		id_ref = "Ref",
31		id_comp = "Comp",
32		id_arm_var,
33		data,
34		arm_ref_comp,
35		module,
36		on_off = reactive(TRUE),
37		input_id = "buckets",
38		output_id = "arms_buckets") {
39	!	iv <- shinyvalidate::InputValidator$new()
40	!	iv1 <- shinyvalidate::InputValidator$new()
41	!	iv2 <- shinyvalidate::InputValidator$new()
42	!	iv2$condition(~ iv1$is_valid())
43	!	iv1$add_rule(id_arm_var, shinyvalidate::sv_required("Treatment variable must be selected"))
44	!	iv2$add_rule(input_id, ~ if (length(.[[id_ref]]) == 0) "A reference arm must be selected")
45	!	iv2$add_rule(input_id, ~ if (length(.[[id_comp]]) == 0) "A comparison arm must be selected")
46	!	iv$add_validator(iv1)
47	!	iv$add_validator(iv2)
48
49
50	!	output[[output_id]] <- renderUI({
51	!	if (isTRUE(on_off())) {
52	!	df <- if (is.reactive(data)) {
53	!	data()
54		} else {
55	!	data
56		}
57	!	check_arm_ref_comp(arm_ref_comp, df, module) ## throws an error if there are issues
58
59	!	arm_var <- req(input[[id_arm_var]])
60
61	!	arm <- df[[arm_var]]
62	!	teal::validate_has_elements(arm, "Treatment variable is empty.")
63
64	!	arm_levels <- if (is.factor(arm)) {
65	!	levels(droplevels(arm))
66		} else {
67	!	unique(arm)
68		}
69	!	default_settings <- arm_ref_comp[[arm_var]]
70
71	!	if (is.null(default_settings)) {
72	!	ref_arm <- arm_levels[1]
73	!	comp_arm <- setdiff(arm_levels, ref_arm)
74		} else {
75	!	ref_arm <- default_settings$ref
76	!	comp_arm <- default_settings$comp
77		}
78
79	!	buckets <- list(ref_arm, comp_arm)
80	!	names(buckets) <- c(id_ref, id_comp)
81
82	!	teal.widgets::draggable_buckets(
83	!	session$ns(input_id),
84	!	label = "Groups",
85	!	elements = character(),
86	!	buckets = buckets
87		)
88		}
89		})
90
91	!	return(iv)
92		}
93
94		#' Check if the Treatment variable is reference or compare
95		#'
96		#' @description `r lifecycle::badge("stable")`
97		#' @param x (`character`)\cr Name of the variable
98		#' @param df_to_check (`data.frame`)\cr table to check
99		#' @param module (`character`)\cr teal module the ref and comp are called in
100		#'
101		#' @keywords internal
102		#'
103		#' @return `TRUE` or `FALSE` whether the variable is in ref or comp
104		check_arm_ref_comp <- function(x, df_to_check, module) {
105	!	msg <- paste("module", module, "argument arm_ref_comp ")
106
107	!	if (!is.null(x)) {
108	!	if (!is.list(x)) {
109	!	stop(msg, "needs to be a list or NULL")
110		}
111
112	!	vars <- names(x)
113	!	if (is.null(vars) \|\| any(vars == "")) {
114	!	stop(msg, "is not named")
115		}
116
117	!	if (!all(vars %in% names(df_to_check))) {
118	!	stop(msg, "refers to variables that are not in the data")
119		}
120
121	!	Map(
122	!	x, vars,
123	!	f = function(xi, var) {
124	!	if (!checkmate::check_list(xi) \|\| !setequal(names(xi), c("comp", "ref"))) {
125	!	stop(
126	!	msg, "definition for Treatment variable ",
127	!	var, " list element needs to be lists with ref and comp elements"
128		)
129		}
130		}
131		)
132		}
133
134	!	invisible(TRUE)
135		}

1		#' Template: Multiple Events by Term
2		#'
3		#' Creates a valid expression to generate a table of multiple events by term.
4		#'
5		#' @inheritParams template_arguments
6		#' @param seq_var (`character`)\cr name of analysis sequence number variable. Used for counting the unique number
7		#' of events.
8		#'
9		#' @inherit template_arguments return
10		#'
11		#' @seealso [tm_t_mult_events()]
12		#'
13		#' @keywords internal
14		template_mult_events <- function(dataname,
15		parentname,
16		arm_var,
17		seq_var,
18		hlt,
19		llt,
20		add_total = TRUE,
21		total_label = default_total_label(),
22		na_level = default_na_str(),
23		event_type = "event",
24		drop_arm_levels = TRUE,
25		basic_table_args = teal.widgets::basic_table_args()) {
26	6x	checkmate::assert_string(dataname)
27	6x	checkmate::assert_string(parentname)
28	6x	checkmate::assert_string(arm_var)
29	6x	checkmate::assert_string(seq_var)
30	6x	checkmate::assert_character(hlt, null.ok = TRUE)
31	6x	checkmate::assert_string(llt, null.ok = FALSE)
32	6x	checkmate::assert_flag(add_total)
33	6x	checkmate::assert_string(total_label)
34	6x	checkmate::assert_string(na_level)
35	6x	checkmate::assert_string(event_type)
36	6x	checkmate::assert_flag(drop_arm_levels)
37
38	6x	y <- list()
39
40		# Start data steps.
41	6x	data_list <- list()
42
43	6x	data_list <- add_expr(
44	6x	data_list,
45	6x	substitute(
46	6x	expr = anl <- df,
47	6x	env = list(df = as.name(dataname))
48		)
49		)
50
51	6x	data_list <- add_expr(
52	6x	data_list,
53	6x	prepare_arm_levels(
54	6x	dataname = "anl",
55	6x	parentname = parentname,
56	6x	arm_var = arm_var,
57	6x	drop_arm_levels = drop_arm_levels
58		)
59		)
60
61	6x	if (is.null(hlt)) {
62	1x	term_vars <- c(llt)
63		} else {
64	5x	term_vars <- c(hlt, llt)
65		}
66
67	6x	data_list <- add_expr(
68	6x	data_list,
69	6x	substitute(
70	6x	expr = anl <- anl %>%
71	6x	df_explicit_na(omit_columns = setdiff(names(anl), term_vars)),
72	6x	env = list(
73	6x	term_vars = term_vars
74		)
75		)
76		)
77
78	6x	data_list <- add_expr(
79	6x	data_list,
80	6x	substitute_names(
81	6x	expr = anl <- anl %>%
82	6x	dplyr::mutate(seq_var = as.factor(seq_var)),
83	6x	names = list(
84	6x	seq_var = as.name(seq_var)
85		)
86		)
87		)
88
89	6x	data_list <- add_expr(
90	6x	data_list,
91	6x	substitute(
92	6x	expr = parentname <- df_explicit_na(parentname, na_level = na_str),
93	6x	env = list(parentname = as.name(parentname), na_str = na_level)
94		)
95		)
96
97	6x	y$data <- bracket_expr(data_list)
98
99	6x	y$layout_prep <- quote(split_fun <- drop_split_levels)
100
101	6x	parsed_basic_table_args <- teal.widgets::parse_basic_table_args(
102	6x	teal.widgets::resolve_basic_table_args(
103	6x	user_table = basic_table_args,
104	6x	module_table = teal.widgets::basic_table_args(show_colcounts = TRUE)
105		)
106		)
107
108		# Start layout steps.
109	6x	layout_list <- list()
110
111	6x	layout_list <- add_expr(layout_list, parsed_basic_table_args)
112	6x	layout_list <- add_expr(
113	6x	layout_list,
114	6x	substitute(
115	6x	expr = rtables::split_cols_by(var = arm_var),
116	6x	env = list(arm_var = arm_var)
117		)
118		)
119
120	6x	if (add_total) {
121	5x	layout_list <- add_expr(
122	5x	layout_list,
123	5x	substitute(
124	5x	expr = rtables::add_overall_col(label = total_label),
125	5x	env = list(total_label = total_label)
126		)
127		)
128		}
129
130	6x	unique_label <- paste0("Total number of patients with at least one ", event_type)
131	6x	nonunique_label <- paste0("Total number of ", event_type, "s")
132
133	6x	layout_list <- add_expr(
134	6x	layout_list,
135	6x	substitute(
136	6x	summarize_num_patients(
137	6x	var = "USUBJID",
138	6x	count_by = seq_var,
139	6x	.stats = c("unique", "nonunique"),
140	6x	.labels = c(
141	6x	unique = unique_label,
142	6x	nonunique = nonunique_label
143		)
144		),
145	6x	env = list(unique_label = unique_label, nonunique_label = nonunique_label, seq_var = seq_var)
146		)
147		)
148
149	6x	if (is.null(hlt)) {
150	1x	layout_list <- add_expr(
151	1x	layout_list,
152	1x	substitute(
153	1x	expr = count_occurrences(vars = llt, .indent_mods = -1L) %>%
154	1x	append_varlabels(dataname, llt, indent = 0L),
155	1x	env = list(
156	1x	dataname = as.name(dataname), llt = llt
157		)
158		)
159		)
160		} else {
161	5x	lbl_lst <- list()
162
163	5x	for (ii in seq_along(hlt)) {
164	11x	hlt_new <- hlt[ii]
165
166	11x	lbl_lst <- add_expr(
167	11x	lbl_lst,
168	11x	substitute(
169	11x	expr = attr(dataname$hlt_new, which = "label"),
170	11x	env = list(
171	11x	dataname = as.name(dataname),
172	11x	hlt_new = hlt_new
173		)
174		)
175		)
176
177	11x	nested <- ifelse(ii == 1, FALSE, TRUE)
178	11x	indent_mod <- ifelse(ii == 1, -1L, 0L)
179
180	11x	layout_list <- add_expr(
181	11x	layout_list,
182	11x	substitute(
183	11x	expr =
184	11x	rtables::split_rows_by(
185	11x	hlt,
186	11x	child_labels = "visible",
187	11x	nested = nested,
188	11x	indent_mod = indent_mod,
189	11x	split_fun = split_fun,
190	11x	label_pos = "topleft",
191	11x	split_label = teal.data::col_labels(dataname[hlt_new])
192		),
193	11x	env = list(
194	11x	hlt = hlt_new,
195	11x	nested = nested,
196	11x	indent_mod = indent_mod,
197	11x	dataname = as.name(dataname),
198	11x	hlt_new = hlt_new
199		)
200		)
201		)
202		}
203
204	5x	layout_list <- add_expr(
205	5x	layout_list,
206	5x	substitute(
207	5x	expr = summarize_num_patients(
208	5x	var = "USUBJID",
209	5x	count_by = seq_var,
210	5x	.stats = c("unique", "nonunique"),
211	5x	.labels = c(
212	5x	unique = unique_label,
213	5x	nonunique = nonunique_label
214		)
215		) %>%
216	5x	count_occurrences(vars = llt, .indent_mods = -1L) %>%
217	5x	append_varlabels(dataname, llt, indent = indent_space),
218	5x	env = list(
219	5x	dataname = as.name(dataname), llt = llt,
220	5x	unique_label = unique_label, nonunique_label = nonunique_label,
221	5x	seq_var = seq_var,
222	5x	indent_space = length(hlt)
223		)
224		)
225		)
226		}
227
228	6x	lyt <- substitute(
229	6x	expr = lyt <- layout_pipe,
230	6x	env = list(layout_pipe = pipe_expr(layout_list))
231		)
232
233	6x	y$layout <- lyt
234
235		# Table
236	6x	y$table <- substitute(
237	6x	expr = result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent),
238	6x	env = list(
239	6x	parent = as.name(parentname)
240		)
241		)
242
243		# Start sorting table
244	6x	if (is.null(hlt)) {
245	1x	pth <- c(llt)
246		} else {
247	5x	pth <- c(rbind(hlt, rep("*", length(hlt))), llt)
248		}
249
250	6x	sort_list <- list()
251
252	6x	sort_list <- add_expr(
253	6x	sort_list,
254	6x	substitute(
255	6x	expr = sorted_result <- result %>%
256	6x	sort_at_path(path = pth, scorefun = score_occurrences),
257	6x	env = list(pth = pth)
258		)
259		)
260
261	6x	y$table_sorted <- bracket_expr(sort_list)
262
263		# Combine tables.
264	6x	y$final_table <- quote(
265	6x	expr = {
266	!	result <- sorted_result
267	!	result
268		}
269		)
270
271	6x	y
272		}
273
274		#' teal Module: Multiple Events by Term
275		#'
276		#' This module produces a table of multiple events by term.
277		#'
278		#' @inheritParams module_arguments
279		#' @inheritParams template_mult_events
280		#' @param seq_var ([teal.transform::choices_selected()])\cr object with
281		#' all available choices and preselected option for variable names that can be used as analysis sequence number
282		#' variable. Used for counting the unique number of events.
283		#'
284		#' @inherit module_arguments return seealso
285		#'
286		#' @examples
287		#' ADSL <- tmc_ex_adsl
288		#' ADCM <- tmc_ex_adcm
289		#' adcm_keys <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4")
290		#'
291		#' join_keys <- default_cdisc_join_keys[c("ADSL", "ADCM")]
292		#' join_keys["ADCM", "ADCM"] <- adcm_keys
293		#'
294		#' app <- init(
295		#' data = cdisc_data(
296		#' ADSL = ADSL,
297		#' ADCM = ADCM,
298		#' code = "
299		#' ADSL <- tmc_ex_adsl
300		#' ADCM <- tmc_ex_adcm
301		#' ",
302		#' join_keys = join_keys
303		#' ),
304		#' modules = modules(
305		#' tm_t_mult_events(
306		#' label = "Concomitant Medications by Medication Class and Preferred Name",
307		#' dataname = "ADCM",
308		#' arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"),
309		#' seq_var = choices_selected("CMSEQ", selected = "CMSEQ", fixed = TRUE),
310		#' hlt = choices_selected(
311		#' choices = variable_choices(ADCM, c("ATC1", "ATC2", "ATC3", "ATC4")),
312		#' selected = c("ATC1", "ATC2", "ATC3", "ATC4")
313		#' ),
314		#' llt = choices_selected(
315		#' choices = variable_choices(ADCM, c("CMDECOD")),
316		#' selected = c("CMDECOD")
317		#' ),
318		#' add_total = TRUE,
319		#' event_type = "treatment"
320		#' )
321		#' )
322		#' )
323		#' if (interactive()) {
324		#' shinyApp(app$ui, app$server)
325		#' }
326		#'
327		#' @export
328		tm_t_mult_events <- function(label,
329		dataname,
330		parentname = ifelse(
331		inherits(arm_var, "data_extract_spec"),
332		teal.transform::datanames_input(arm_var),
333		"ADSL"
334		),
335		arm_var,
336		seq_var,
337		hlt,
338		llt,
339		add_total = TRUE,
340		total_label = default_total_label(),
341		na_level = default_na_str(),
342		event_type = "event",
343		drop_arm_levels = TRUE,
344		pre_output = NULL,
345		post_output = NULL,
346		basic_table_args = teal.widgets::basic_table_args()) {
347	!	message("Initializing tm_t_mult_events")
348	!	checkmate::assert_string(label)
349	!	checkmate::assert_string(dataname)
350	!	checkmate::assert_string(parentname)
351	!	checkmate::assert_class(arm_var, "choices_selected")
352	!	checkmate::assert_class(seq_var, "choices_selected")
353	!	checkmate::assert_class(hlt, "choices_selected")
354	!	checkmate::assert_class(llt, "choices_selected")
355	!	checkmate::assert_string(event_type)
356	!	checkmate::assert_flag(add_total)
357	!	checkmate::assert_string(total_label)
358	!	checkmate::assert_string(na_level)
359	!	checkmate::assert_flag(drop_arm_levels)
360	!	checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
361	!	checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
362	!	checkmate::assert_class(basic_table_args, "basic_table_args")
363
364	!	args <- as.list(environment())
365
366	!	data_extract_list <- list(
367	!	arm_var = cs_to_des_select(arm_var, dataname = parentname),
368	!	seq_var = cs_to_des_select(seq_var, dataname = dataname),
369	!	hlt = cs_to_des_select(hlt, dataname = dataname, multiple = TRUE, ordered = TRUE),
370	!	llt = cs_to_des_select(llt, dataname = dataname)
371		)
372
373	!	module(
374	!	label = label,
375	!	ui = ui_t_mult_events_byterm,
376	!	server = srv_t_mult_events_byterm,
377	!	ui_args = c(data_extract_list, args),
378	!	server_args = c(
379	!	data_extract_list,
380	!	list(
381	!	dataname = dataname,
382	!	parentname = parentname,
383	!	event_type = event_type,
384	!	label = label,
385	!	total_label = total_label,
386	!	na_level = na_level,
387	!	basic_table_args = basic_table_args
388		)
389		),
390	!	datanames = teal.transform::get_extract_datanames(data_extract_list)
391		)
392		}
393
394		#' @keywords internal
395		ui_t_mult_events_byterm <- function(id, ...) {
396	!	ns <- NS(id)
397	!	a <- list(...)
398	!	is_single_dataset_value <- teal.transform::is_single_dataset(a$arm_var, a$seq_var, a$hlt, a$llt)
399
400	!	teal.widgets::standard_layout(
401	!	output = teal.widgets::white_small_well(
402	!	teal.widgets::table_with_settings_ui(ns("table"))
403		),
404	!	encoding = tags$div(
405		### Reporter
406	!	teal.reporter::simple_reporter_ui(ns("simple_reporter")),
407		###
408	!	tags$label("Encodings", class = "text-primary"),
409	!	teal.transform::datanames_input(a[c("arm_var", "seq_var", "hlt", "llt")]),
410	!	teal.transform::data_extract_ui(
411	!	id = ns("arm_var"),
412	!	label = "Select Treatment Variable",
413	!	data_extract_spec = a$arm_var,
414	!	is_single_dataset = is_single_dataset_value
415		),
416	!	teal.transform::data_extract_ui(
417	!	id = ns("hlt"),
418	!	label = "Event High Level Term",
419	!	data_extract_spec = a$hlt,
420	!	is_single_dataset = is_single_dataset_value
421		),
422	!	teal.transform::data_extract_ui(
423	!	id = ns("llt"),
424	!	label = "Event Low Level Term",
425	!	data_extract_spec = a$llt,
426	!	is_single_dataset = is_single_dataset_value
427		),
428	!	checkboxInput(ns("add_total"), "Add All Patients columns", value = a$add_total),
429	!	teal.widgets::panel_group(
430	!	teal.widgets::panel_item(
431	!	"Additional table settings",
432	!	checkboxInput(
433	!	ns("drop_arm_levels"),
434	!	label = "Drop columns not in filtered analysis dataset",
435	!	value = a$drop_arm_levels
436		)
437		)
438		),
439	!	teal.widgets::panel_group(
440	!	teal.widgets::panel_item(
441	!	"Additional Variables Info",
442	!	teal.transform::data_extract_ui(
443	!	id = ns("seq_var"),
444	!	label = "Analysis Sequence Number",
445	!	data_extract_spec = a$seq_var,
446	!	is_single_dataset = is_single_dataset_value
447		)
448		)
449		)
450		),
451	!	forms = tagList(
452	!	teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
453		),
454	!	pre_output = a$pre_output,
455	!	post_output = a$post_output
456		)
457		}
458
459		#' @keywords internal
460		srv_t_mult_events_byterm <- function(id,
461		data,
462		reporter,
463		filter_panel_api,
464		dataname,
465		parentname,
466		event_type,
467		arm_var,
468		seq_var,
469		hlt,
470		llt,
471		drop_arm_levels,
472		label,
473		total_label,
474		na_level,
475		basic_table_args) {
476	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
477	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
478	!	checkmate::assert_class(data, "reactive")
479	!	checkmate::assert_class(shiny::isolate(data()), "teal_data")
480
481	!	moduleServer(id, function(input, output, session) {
482	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.modules.clinical")
483	!	selector_list <- teal.transform::data_extract_multiple_srv(
484	!	data_extract = list(
485	!	arm_var = arm_var,
486	!	seq_var = seq_var,
487	!	hlt = hlt,
488	!	llt = llt
489		),
490	!	datasets = data,
491	!	select_validation_rule = list(
492	!	arm_var = shinyvalidate::sv_required("Please select a treatment variable"),
493	!	llt = shinyvalidate::sv_required("Please select a \"LOW LEVEL TERM\" variable")
494		)
495		)
496
497	!	iv_r <- reactive({
498	!	iv <- shinyvalidate::InputValidator$new()
499	!	teal.transform::compose_and_enable_validators(iv, selector_list, c("arm_var", "llt"))
500		})
501
502	!	anl_merge_inputs <- teal.transform::merge_expression_srv(
503	!	id = "anl_merge",
504	!	datasets = data,
505	!	selector_list = selector_list,
506	!	merge_function = "dplyr::inner_join"
507		)
508
509	!	adsl_merge_inputs <- teal.transform::merge_expression_module(
510	!	id = "adsl_merge",
511	!	datasets = data,
512	!	data_extract = list(arm_var = arm_var),
513	!	anl_name = "ANL_ADSL"
514		)
515
516	!	anl_q <- reactive({
517	!	data() %>%
518	!	teal.code::eval_code(as.expression(anl_merge_inputs()$expr)) %>%
519	!	teal.code::eval_code(as.expression(adsl_merge_inputs()$expr))
520		})
521
522	!	validate_checks <- reactive({
523	!	teal::validate_inputs(iv_r())
524	!	adsl_filtered <- anl_q()[[parentname]]
525	!	anl_filtered <- anl_q()[[dataname]]
526
527	!	anl_m <- anl_merge_inputs()
528	!	input_arm_var <- as.vector(anl_m$columns_source$arm_var)
529	!	input_seq_var <- as.vector(anl_m$columns_source$seq_var)
530
531	!	input_hlt <- as.vector(anl_m$columns_source$hlt)
532	!	input_llt <- as.vector(anl_m$columns_source$llt)
533
534
535	!	validate(
536	!	need(is.factor(adsl_filtered[[input_arm_var]]), "Treatment variable is not a factor.")
537		)
538	!	validate(
539	!	need(is.integer(anl_filtered[[input_seq_var]]), "Analysis sequence variable is not an integer.")
540		)
541
542		# validate inputs
543	!	validate_standard_inputs(
544	!	adsl = adsl_filtered,
545	!	adslvars = c("USUBJID", "STUDYID", input_arm_var),
546	!	anl = anl_filtered,
547	!	anlvars = c("USUBJID", "STUDYID", input_seq_var, input_hlt, input_llt),
548	!	arm_var = input_arm_var
549		)
550		})
551
552		# The R-code corresponding to the analysis.
553	!	all_q <- reactive({
554	!	validate_checks()
555
556	!	anl_q <- anl_q()
557	!	anl_m <- anl_merge_inputs()
558
559	!	input_hlt <- names(anl_m$columns_source$hlt)
560	!	input_llt <- names(anl_m$columns_source$llt)
561
562	!	hlt_labels <- mapply(function(x) rtables::obj_label(anl_q[["ANL"]][[x]]), input_hlt)
563	!	llt_labels <- mapply(function(x) rtables::obj_label(anl_q[["ANL"]][[x]]), input_llt)
564
565	!	basic_table_args$title <- ifelse(
566	!	is.null(basic_table_args$title),
567	!	paste(
568	!	"Concomitant Medications by",
569	!	paste(hlt_labels, collapse = ", "),
570	!	"and",
571	!	paste(llt_labels, collapse = ", ")
572		),
573	!	basic_table_args$title
574		)
575
576	!	my_calls <- template_mult_events(
577	!	dataname = "ANL",
578	!	parentname = "ANL_ADSL",
579	!	arm_var = names(anl_m$columns_source$arm_var),
580	!	seq_var = names(anl_m$columns_source$seq_var),
581	!	hlt = if (length(input_hlt) != 0) input_hlt else NULL,
582	!	llt = input_llt,
583	!	add_total = input$add_total,
584	!	total_label = total_label,
585	!	na_level = na_level,
586	!	event_type = event_type,
587	!	drop_arm_levels = input$drop_arm_levels,
588	!	basic_table_args = basic_table_args
589		)
590	!	teal.code::eval_code(anl_q, as.expression(my_calls))
591		})
592
593		# Outputs to render.
594	!	table_r <- reactive(all_q()[["result"]])
595
596	!	teal.widgets::table_with_settings_srv(id = "table", table_r = table_r)
597
598		# Render R code.
599	!	teal.widgets::verbatim_popup_srv(
600	!	id = "rcode",
601	!	verbatim_content = reactive(teal.code::get_code(all_q())),
602	!	title = label
603		)
604
605		### REPORTER
606	!	if (with_reporter) {
607	!	card_fun <- function(comment, label) {
608	!	card <- teal::report_card_template(
609	!	title = "Multiple Events by Term Table",
610	!	label = label,
611	!	with_filter = with_filter,
612	!	filter_panel_api = filter_panel_api
613		)
614	!	card$append_text("Table", "header3")
615	!	card$append_table(table_r())
616	!	if (!comment == "") {
617	!	card$append_text("Comment", "header3")
618	!	card$append_text(comment)
619		}
620	!	card$append_src(teal.code::get_code(all_q()))
621	!	card
622		}
623	!	teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
624		}
625		###
626		})
627		}

1		#' Substitute in Quoted Expressions
2		#'
3		#' This version of substitute is needed because [substitute()] does not
4		#' evaluate it's first argument, and it's often useful to be able to modify
5		#' a quoted expression.
6		#'
7		#' @md
8		#' @param qexpr (`language`)\cr a quoted expression.
9		#' @param env (`environment` or `list`)\cr requested variable substitutions.
10		#'
11		#' @return The modified expression.
12		#' @note This is simplified from the package `pryr` to avoid another dependency.
13		#' @seealso [substitute_names()]
14		#'
15		#' @keywords internal
16		#'
17		substitute_q <- function(qexpr, env) {
18	255x	stopifnot(is.language(qexpr))
19	254x	call <- substitute(substitute(qexpr, env), list(qexpr = qexpr))
20	254x	eval(call)
21		}
22
23		#' Substitute Names in a Quoted Expression
24		#'
25		#' This function substitutes the names on both left- and right-hand sides in a quoted expression.
26		#' In addition it can also do other standard substitutions on the right-hand side.
27		#'
28		#' @md
29		#' @param expr (`language`)\cr an expression.
30		#' @param names (named `list` of `name`)\cr requested name substitutions.
31		#' @param others (named `list`)\cr requested other substitutions which will only happen on the
32		#' right-hand side.
33		#'
34		#' @name substitute_names
35		#' @return The modified expression.
36		#' @seealso [substitute_q()]
37		#'
38		#' @keywords internal
39		#'
40		substitute_names <- function(expr, names, others = list()) {
41	252x	checkmate::assert_list(names, min.len = 1, names = "unique", types = "name")
42	252x	checkmate::assert_list(others, min.len = 0, names = "unique")
43	252x	checkmate::assert_names(names(names), disjunct.from = names(others))
44
45	252x	expr <- substitute(expr)
46	252x	expr <- substitute_rhs(expr, c(names, others))
47	252x	substitute_lhs_names(expr, names)
48		}
49
50		#' @md
51		#' @describeIn substitute_names Helper function to just substitute the top-level names on the left-hand side in a
52		#' quoted expression.
53		#' @inheritParams substitute_q
54		#' @keywords internal
55		h_subst_lhs_names <- function(qexpr, names) {
56	1137x	will_replace <- names(names)
57	1137x	to_replace <- names(qexpr)
58	1137x	matches <- match(x = to_replace, table = will_replace)
59	1137x	which_found <- which(!is.na(matches))
60	1137x	names_as_strings <- sapply(names, as.character)
61	1137x	names(qexpr)[which_found] <- names_as_strings[matches[which_found]]
62	1137x	qexpr
63		}
64
65		#' @md
66		#' @describeIn substitute_names recursively substitutes all names on the left-hand sides in a quoted expression.
67		#' @inheritParams substitute_q
68		#' @keywords internal
69		substitute_lhs_names <- function(qexpr, names) {
70	3217x	if (length(qexpr) == 1L) {
71	2081x	return(qexpr)
72		}
73	1136x	qexpr <- h_subst_lhs_names(qexpr, names)
74	1136x	for (i in seq_along(qexpr)) {
75	2963x	qexpr[[i]] <- substitute_lhs_names(qexpr[[i]], names)
76		}
77	1136x	qexpr
78		}
79
80		#' @md
81		#' @describeIn substitute_names substitutes on the right-hand side in a quoted expression.
82		#' Note that this is just a synonym for [substitute_q()].
83		#' @inheritParams substitute_q
84		#' @keywords internal
85		substitute_rhs <- function(qexpr, env) {
86	253x	substitute_q(qexpr, env)
87		}

1		#' Validate standard input values for a teal module
2		#'
3		#' @description `r lifecycle::badge("stable")`
4		#' @param adsl data.frame with subject-level data
5		#' @param adslvars required variables from `ADSL`
6		#' @param anl data.frame with analysis data
7		#' @param anlvars required variables from `ANL`
8		#' @param need_arm flag indicating whether grouping variable `arm_var`
9		#' is required or can be optionally `NULL`.
10		#' @param arm_var character with name of grouping variable, typically arm
11		#' @param ref_arm character with name of reference level in `arm_var`
12		#' @param comp_arm character with name for comparison level in `arm_var`
13		#' @param min_n_levels_armvar minimum number of levels in grouping variable `arm_var`.
14		#' Defaults to 1, `NULL` for no minimum.
15		#' @param max_n_levels_armvar maximum number of levels in grouping variable `arm_var`.
16		#' Use `NULL` for no maximum.
17		#' @param min_nrow minimum number of observations in `ADSL` and `ANL`
18		#'
19		#' @keywords internal
20		#'
21		validate_standard_inputs <- function(adsl,
22		adslvars = character(0),
23		anl,
24		anlvars = character(0),
25		need_arm = TRUE,
26		arm_var,
27		ref_arm,
28		comp_arm,
29		min_n_levels_armvar = 1L,
30		max_n_levels_armvar = 100L,
31		min_nrow = 1) {
32	!	teal::validate_has_data(adsl, min_nrow = min_nrow)
33	!	teal::validate_has_data(anl, min_nrow = min_nrow)
34
35	!	if (length(adslvars) > 0) {
36	!	teal::validate_has_variable(adsl, c(adslvars, arm_var))
37		}
38	!	if (length(anlvars) > 0) {
39	!	teal::validate_has_variable(anl, anlvars)
40		}
41
42	!	if (need_arm \|\| (!(need_arm) && !is.null(arm_var))) {
43	!	teal::validate_has_elements(arm_var, "Treatment variable name is empty.")
44	!	teal::validate_has_variable(adsl, arm_var, "Treatment variable not found.")
45
46	!	validate_n_levels(
47	!	adsl[[arm_var]],
48	!	min_levels = min_n_levels_armvar,
49	!	max_levels = max_n_levels_armvar,
50	!	var_name = arm_var
51		)
52
53	!	validate_arm(adsl[[arm_var]])
54
55	!	if (!missing(comp_arm)) {
56	!	teal::validate_has_elements(comp_arm, "Comparison treatments selection is empty.")
57		}
58	!	if (!missing(ref_arm)) {
59	!	teal::validate_has_elements(ref_arm, "Reference treatments selection is empty.")
60		}
61
62	!	if (!missing(comp_arm) && !missing(ref_arm)) {
63	!	teal::validate_in(
64	!	c(comp_arm, ref_arm), adsl[[arm_var]],
65	!	"Current ADSL data does not have observations from the reference and comparison treatments."
66		)
67		}
68		}
69		}
70
71		#' Check if vector is valid as to be used as a treatment arm variable
72		#'
73		#' @details A validate error is returned if the vector is not a factor with a more detailed
74		#' error message if any of the entries are empty strings
75		#' @param arm_vec vector to be validated
76		#' @keywords internal
77		#'
78		validate_arm <- function(arm_vec) {
79	6x	validate(shiny::need(is.factor(arm_vec), "Treatment variable is not a factor"))
80	4x	validate(
81	4x	need(
82	4x	all(trimws(levels(arm_vec)) != ""),
83	4x	"Treatment values cannot contain empty strings"
84		)
85		)
86		}

1		# This file contains functions that help with plotting in other modules
2
3		#' Facetting formula `x_facet ~ y_facet`
4		#'
5		#' @description `r lifecycle::badge("stable")`
6		#' Replaces `x_facet` or `y_facet` by . when empty character
7		#'
8		#' @md
9		#' @param x_facet (`character(1)`)\cr
10		#' name of x facet, if empty, will not facet along x.
11		#' @param y_facet (`character(1)`)\cr
12		#' name of y facet, if empty, will not facet along y.
13		#'
14		#' @return facet grid formula `formula(x_facet ~ y_facet)`
15		#'
16		#' @keywords internal
17		#'
18		facet_grid_formula <- function(x_facet, y_facet) {
19	1x	if (length(x_facet) == 0) x_facet <- "."
20	2x	if (length(y_facet) == 0) y_facet <- "."
21	4x	checkmate::assert_string(x_facet)
22	4x	checkmate::assert_string(y_facet)
23	!	if (x_facet == y_facet) stop("'x_facet' and 'y_facet' must not be equal.")
24	4x	stats::as.formula(paste0(y_facet, " ~ ", x_facet)) # must invert it
25		}

1		#' Get full label, useful for annotating plots
2		#'
3		#' @param dataset (`data.frame`)\cr dataset
4		#' @param column (`character`)\cr column to get label from
5		#' @param omit_raw_name (`logical`)\cr omits the raw name in square brackets if label is found
6		#'
7		#' @return "Label `[Column name]`" if label exists, otherwise "Column name".
8		#'
9		#' @examples
10		#' data <- mtcars
11		#' column_annotation_label(data, "cyl")
12		#' attr(data[["cyl"]], "label") <- "Cylinder"
13		#' column_annotation_label(data, "cyl")
14		#' column_annotation_label(data, "cyl", omit_raw_name = TRUE)
15		#' column_annotation_label(tmc_ex_adsl, "ACTARM")
16		#' @export
17		column_annotation_label <- function(dataset, column, omit_raw_name = FALSE) {
18	!	checkmate::assert_data_frame(dataset)
19	!	checkmate::assert_string(column)
20	!	checkmate::assert_flag(omit_raw_name)
21
22	!	if (is.null(attr(dataset[[column]], "label"))) {
23	!	column
24		} else {
25	!	col_label <- attr(dataset[[column]], "label")
26	!	if (omit_raw_name) {
27	!	col_label
28		} else {
29	!	sprintf("%s [%s]", col_label, column)
30		}
31		}
32		}